release
import-0.87
nomennescio
parent
c800d28665
commit
76e6ede2ec
22
Makefile
22
Makefile
|
|
@ -3,16 +3,16 @@ CC = gcc
|
||||||
BINARY = f
|
BINARY = f
|
||||||
IMAGE = factor.image
|
IMAGE = factor.image
|
||||||
BUNDLE = Factor.app
|
BUNDLE = Factor.app
|
||||||
VERSION = 0.86
|
VERSION = 0.87
|
||||||
DISK_IMAGE_DIR = Factor-$(VERSION)
|
DISK_IMAGE_DIR = Factor-$(VERSION)
|
||||||
DISK_IMAGE = Factor-$(VERSION).dmg
|
DISK_IMAGE = Factor-$(VERSION).dmg
|
||||||
LIBPATH = -L/usr/X11R6/lib
|
LIBPATH = -L/usr/X11R6/lib
|
||||||
|
|
||||||
ifdef DEBUG
|
ifdef DEBUG
|
||||||
CFLAGS = -pg -O1
|
CFLAGS = -g -std=gnu99
|
||||||
STRIP = touch
|
STRIP = touch
|
||||||
else
|
else
|
||||||
CFLAGS = -Wall -O3 -ffast-math -fomit-frame-pointer $(SITE_CFLAGS)
|
CFLAGS = -Wall -O3 -ffast-math -std=gnu99 $(SITE_CFLAGS)
|
||||||
STRIP = strip
|
STRIP = strip
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
|
@ -40,7 +40,8 @@ OBJS = $(PLAF_OBJS) \
|
||||||
default:
|
default:
|
||||||
@echo "Run 'make' with one of the following parameters:"
|
@echo "Run 'make' with one of the following parameters:"
|
||||||
@echo ""
|
@echo ""
|
||||||
@echo "freebsd"
|
@echo "freebsd-x86"
|
||||||
|
@echo "freebsd-amd64"
|
||||||
@echo "linux-x86"
|
@echo "linux-x86"
|
||||||
@echo "linux-amd64"
|
@echo "linux-amd64"
|
||||||
@echo "linux-ppc"
|
@echo "linux-ppc"
|
||||||
|
|
@ -62,8 +63,11 @@ default:
|
||||||
@echo ""
|
@echo ""
|
||||||
@echo "export SITE_CFLAGS=\"-march=pentium4 -ffast-math\""
|
@echo "export SITE_CFLAGS=\"-march=pentium4 -ffast-math\""
|
||||||
|
|
||||||
freebsd:
|
freebsd-x86:
|
||||||
$(MAKE) $(BINARY) CONFIG=vm/Config.freebsd
|
$(MAKE) $(BINARY) CONFIG=vm/Config.freebsd.x86
|
||||||
|
|
||||||
|
freebsd-amd64:
|
||||||
|
$(MAKE) $(BINARY) CONFIG=vm/Config.freebsd.amd64
|
||||||
|
|
||||||
macosx-freetype:
|
macosx-freetype:
|
||||||
ln -sf libfreetype.6.dylib \
|
ln -sf libfreetype.6.dylib \
|
||||||
|
|
@ -73,10 +77,10 @@ macosx-ppc: macosx-freetype
|
||||||
$(MAKE) $(BINARY) CONFIG=vm/Config.macosx.ppc
|
$(MAKE) $(BINARY) CONFIG=vm/Config.macosx.ppc
|
||||||
|
|
||||||
macosx-x86: macosx-freetype
|
macosx-x86: macosx-freetype
|
||||||
$(MAKE) $(BINARY) CONFIG=vm/Config.macosx
|
$(MAKE) $(BINARY) CONFIG=vm/Config.macosx.x86
|
||||||
|
|
||||||
linux-x86:
|
linux-x86:
|
||||||
$(MAKE) $(BINARY) CONFIG=vm/Config.linux
|
$(MAKE) $(BINARY) CONFIG=vm/Config.linux.x86
|
||||||
$(STRIP) $(BINARY)
|
$(STRIP) $(BINARY)
|
||||||
|
|
||||||
linux-amd64:
|
linux-amd64:
|
||||||
|
|
@ -124,6 +128,7 @@ macosx.dmg:
|
||||||
-o -name '*.fgen' \
|
-o -name '*.fgen' \
|
||||||
-o -name '*.tex' \
|
-o -name '*.tex' \
|
||||||
-o -name '*.fhtml' \
|
-o -name '*.fhtml' \
|
||||||
|
-o -name '*.furnace' \
|
||||||
-o -name '*.xml' \
|
-o -name '*.xml' \
|
||||||
-o -name '*.js' \) \
|
-o -name '*.js' \) \
|
||||||
-exec ./cp_dir {} $(DISK_IMAGE_DIR)/Factor/{} \;
|
-exec ./cp_dir {} $(DISK_IMAGE_DIR)/Factor/{} \;
|
||||||
|
|
@ -140,7 +145,6 @@ clean:
|
||||||
rm -f vm/*.o
|
rm -f vm/*.o
|
||||||
|
|
||||||
clean.app:
|
clean.app:
|
||||||
rm -rf $(BUNDLE)/Contents/Resources/
|
|
||||||
rm -f $(BUNDLE)/Contents/MacOS/Factor
|
rm -f $(BUNDLE)/Contents/MacOS/Factor
|
||||||
|
|
||||||
.c.o:
|
.c.o:
|
||||||
|
|
|
||||||
23
README.txt
23
README.txt
|
|
@ -160,16 +160,23 @@ the command prompt:
|
||||||
|
|
||||||
f.exe boot.image.pentium4 (or boot.image.x86)
|
f.exe boot.image.pentium4 (or boot.image.x86)
|
||||||
|
|
||||||
Once bootstrapped, double-clicking f.exe starts the Factor UI. There is
|
Once bootstrapped, double-clicking f.exe starts the Factor UI.
|
||||||
no option to run the listener in the command prompt on Windows.
|
|
||||||
|
To run the listener in the command prompt:
|
||||||
|
|
||||||
|
f.exe -shell=tty
|
||||||
|
|
||||||
* Source organization
|
* Source organization
|
||||||
|
|
||||||
doc/ - the developer's handbook, and various other bits and pieces
|
The following four directories are managed by the module system; consult
|
||||||
contrib/ - various handy libraries not part of the core
|
the documentation for details:
|
||||||
examples/ - small examples illustrating various language features
|
|
||||||
|
apps/ - user-contributed applications
|
||||||
|
libs/ - user-contributed libraries
|
||||||
|
demos/ - small examples illustrating various language features
|
||||||
|
core/ - sources for the library, written in Factor
|
||||||
|
|
||||||
fonts/ - TrueType fonts used by UI
|
fonts/ - TrueType fonts used by UI
|
||||||
library/ - sources for the library, written in Factor
|
|
||||||
vm/ - sources for the Factor runtime, written in C
|
vm/ - sources for the Factor runtime, written in C
|
||||||
|
|
||||||
* Community
|
* Community
|
||||||
|
|
@ -190,10 +197,6 @@ Doug Coleman: Mersenne Twister RNG, Windows port
|
||||||
Eduardo Cavazos: X11 binding
|
Eduardo Cavazos: X11 binding
|
||||||
Joshua Grams: PowerPC instruction cache flush code
|
Joshua Grams: PowerPC instruction cache flush code
|
||||||
Mackenzie Straight: Windows port
|
Mackenzie Straight: Windows port
|
||||||
Trent Buck: Debian package
|
|
||||||
|
|
||||||
A number of contributed libraries not part of the core can be found in
|
|
||||||
contrib/. See contrib/README.txt for details.
|
|
||||||
|
|
||||||
Have fun!
|
Have fun!
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,50 +1,61 @@
|
||||||
+ 0.87:
|
+ 0.87:
|
||||||
|
|
||||||
- fix search unit test
|
- error popup obscures input area
|
||||||
|
- cocoa: international keys don't work
|
||||||
|
- embedded.factor is O(n^2)
|
||||||
|
|
||||||
|
+ 0.88:
|
||||||
|
|
||||||
|
- models: don't do redundant work
|
||||||
|
- test factor on linux/ppc
|
||||||
|
- poorly documented vocabs:
|
||||||
|
- alien
|
||||||
|
- cocoa
|
||||||
|
- command-line
|
||||||
|
- compiler
|
||||||
|
- completion
|
||||||
|
- image
|
||||||
|
- interpreter
|
||||||
|
- objc
|
||||||
|
- optimizer
|
||||||
|
- grid-lines are rendered incorrectly
|
||||||
|
- lisppaste gui
|
||||||
|
- growable data heap
|
||||||
|
- variable width word wrap
|
||||||
|
- graphical crossref tool
|
||||||
|
- inspector where slot values can be changed
|
||||||
|
- compiled call traces do not work if the runtime is built with
|
||||||
|
-fomit-frame-pointer on ppc
|
||||||
|
- use crc32 instead of modification date in reload-modules
|
||||||
|
- top level window positioning on ms windows
|
||||||
- these things are "Too Slow":
|
- these things are "Too Slow":
|
||||||
- all-words
|
|
||||||
- make-image
|
- make-image
|
||||||
- workspace-window
|
- workspace-window
|
||||||
- menu should stay up if mouse button released
|
- apropos
|
||||||
- roundoff is still not quite right with tracks
|
- 10000 [ dup number>string ] map describe in the UI
|
||||||
- grid displays quickly now, but constructing large amounts of gadgets
|
- available-modules
|
||||||
is slow: eg, 10000 [ dup number>string ] map describe
|
- string-lines
|
||||||
- completion is not ideal: eg, C+e "buttons"
|
- md5, crc32
|
||||||
- slider needs to be modelized
|
- all-words [ word-name ] map prune [ words-named ] map
|
||||||
- better help result ranking
|
- 100000 [ "\"hello\" not" eval drop ] times
|
||||||
- help search looks funny
|
|
||||||
- variable width word wrap
|
|
||||||
- graphical module manager tool
|
|
||||||
- graphical crossref tool
|
|
||||||
- ui browser: show currently selected vocab & words
|
|
||||||
- auto-update browser and help when sources reload
|
- auto-update browser and help when sources reload
|
||||||
- amd64 structs-by-value bug
|
|
||||||
- intrinsic fixnum>float float>fixnum
|
|
||||||
- mac intel: struct returns from objc methods
|
- mac intel: struct returns from objc methods
|
||||||
- faster apropos
|
|
||||||
- compiled call traces
|
|
||||||
- workspace window takes too long to come up
|
|
||||||
- new windows don't always have focus, eg focus follows mouse
|
- new windows don't always have focus, eg focus follows mouse
|
||||||
- dataflow for [ ] map [ ] subset looks weird (wrong?)
|
|
||||||
- listener commands from a menu should not include 'hide-glass' etc
|
|
||||||
- bogus compile errors?
|
|
||||||
- recompile get/set/>n/n>/ndrop if needed
|
- recompile get/set/>n/n>/ndrop if needed
|
||||||
- cross-word type inference
|
- cross-word type inference
|
||||||
- callback scheduling issue
|
|
||||||
- windows crash
|
|
||||||
- ui docs
|
|
||||||
- some kind of declarative wiring framework for ui
|
- some kind of declarative wiring framework for ui
|
||||||
- overhaul models, set-model* is crap
|
- if we're printing a block on multiple lines, break at some words like
|
||||||
- allow rebinding styles
|
set off on % # , ... and assembler opcodes
|
||||||
- fix windows gcc issue
|
- don't end lines with literals, shuffle words or symbols?
|
||||||
- robustify stepper -- see if step back past a throw works
|
- see should try to not show ; on a line by itself
|
||||||
- empty callstack: should throw an exception instead of being a critical error
|
- IN: on its own line if the entire 'see' form doesn't fit
|
||||||
|
- command buttons: indicate shortcuts
|
||||||
|
- how do we refer to command shortcuts in the docs?
|
||||||
|
|
||||||
+ ui:
|
+ ui:
|
||||||
|
|
||||||
- some way of intercepting all gestures
|
- browser tool: dropdown menu button for definition operations
|
||||||
- how do we refer to command shortcuts in the docs?
|
- copying pane output
|
||||||
- fix top level window positioning
|
|
||||||
- editor:
|
- editor:
|
||||||
- autoscroll
|
- autoscroll
|
||||||
- transpose char/word/line
|
- transpose char/word/line
|
||||||
|
|
@ -52,54 +63,35 @@
|
||||||
- see if its possible to only repaint dirty regions
|
- see if its possible to only repaint dirty regions
|
||||||
- structure editor
|
- structure editor
|
||||||
|
|
||||||
+ module system:
|
+ compiler/ffi:
|
||||||
|
|
||||||
- track a list of assets loaded from each module's file
|
|
||||||
- C types should be words
|
- C types should be words
|
||||||
- TYPEDEF: float { ... } { ... } ; ==> \ float T{ c-type ... } "c-type" swp
|
- TYPEDEF: float { ... } { ... } ; ==> \ float T{ c-type ... } "c-type" swp
|
||||||
- TYPEDEF: float FTFloat ; ==> \ float \ FTFloat "c-type" swp
|
- TYPEDEF: float FTFloat ; ==> \ float \ FTFloat "c-type" swp
|
||||||
- make typedef aliasing explicit
|
- make typedef aliasing explicit
|
||||||
- seeing a C struct word should show its def
|
- seeing a C struct word should show its def
|
||||||
- file out
|
- amd64 structs-by-value bug
|
||||||
|
|
||||||
+ compiler/ffi:
|
|
||||||
|
|
||||||
- %allot-bignum-signed-2 is broken on both platforms
|
- %allot-bignum-signed-2 is broken on both platforms
|
||||||
- we may be able to remove the dlsym primitive
|
|
||||||
- [ [ dup call ] dup call ] infer hangs
|
- [ [ dup call ] dup call ] infer hangs
|
||||||
- stdcall callbacks
|
- stdcall callbacks
|
||||||
- callstack overflow when compiling mutually recursive inline words
|
- callstack overflow when compiling mutually recursive inline words
|
||||||
- test what is done in the case of an invalid declaration on an inline
|
|
||||||
recursive
|
|
||||||
- ppc64 backend
|
|
||||||
- arm backend
|
- arm backend
|
||||||
- float= doesn't consider nans equal
|
- float= doesn't consider nans equal
|
||||||
- C functions returning structs by value
|
- C functions returning structs by value
|
||||||
- compiled continuations
|
- compiled continuations
|
||||||
|
|
||||||
+ prettyprinter:
|
|
||||||
|
|
||||||
- clean it up
|
|
||||||
- if we're printing a block on multiple lines, break at some words like
|
|
||||||
set off on % # , ... and assembler opcodes
|
|
||||||
- don't end lines with literals, shuffle words or symbols?
|
|
||||||
- see should try to not show ; on a line by itself
|
|
||||||
- IN: on its own line if the entire 'see' form doesn't fit
|
|
||||||
- don't build entire tree to print first
|
|
||||||
|
|
||||||
+ misc:
|
+ misc:
|
||||||
|
|
||||||
|
- if a word drops the stack pointer below the bottom, then an error
|
||||||
|
won't be thrown until the next word accesses the stack
|
||||||
|
- prettyprinter: don't build entire tree to print first
|
||||||
|
- automatic help/effects for slot accessors
|
||||||
|
- tuple shape changes
|
||||||
- should be possible to reload any source file in library
|
- should be possible to reload any source file in library
|
||||||
- growable data heap
|
|
||||||
- minor GC takes too long now, we should card mark code heap
|
- minor GC takes too long now, we should card mark code heap
|
||||||
- buffer-ptr should be an alien
|
- buffer-ptr should be an alien
|
||||||
- swap nappend ==> nappend
|
- swap nappend ==> nappend
|
||||||
- gdb triggers 'multiple i/o ops on port' error
|
|
||||||
- incremental GC
|
- incremental GC
|
||||||
- UDP
|
- UDP
|
||||||
- slice: if sequence or seq start is changed, abstraction violation
|
- slice: if sequence or seq start is changed, abstraction violation
|
||||||
- hashed generic method dispatch
|
- hashed generic method dispatch
|
||||||
|
|
||||||
+ httpd:
|
|
||||||
|
|
||||||
- remaining HTML issues need fixing
|
|
||||||
|
|
@ -0,0 +1,29 @@
|
||||||
|
This directory contains Factor code that is not part of the core
|
||||||
|
library, but is useful enough to ship with the Factor distribution.
|
||||||
|
|
||||||
|
Modules can be loaded from the listener:
|
||||||
|
|
||||||
|
"apps/modulename" require
|
||||||
|
|
||||||
|
Available applications:
|
||||||
|
|
||||||
|
- automata -- Graphics demo for the UI (Eduardo Cavazos)
|
||||||
|
- benchmarks -- Various performance benchmarks (Slava Pestov)
|
||||||
|
- boids -- Graphics demo for the UI (Eduardo Cavazos)
|
||||||
|
- factory -- X11 window manager (Eduardo Cavazos)
|
||||||
|
- furnace-fjsc -- Web frontend for libs/fjsc (Chris Double)
|
||||||
|
- furnace-onigiri -- Weblog engine (Matthew Willis)
|
||||||
|
- furnace-pastebin -- demo app for Furnace (Slava Pestov)
|
||||||
|
- help-lint -- online documentation typo checker (Slava Pestov)
|
||||||
|
- hexdump -- Hexdump routine (Doug Coleman)
|
||||||
|
- lindenmayer -- L-systems tool (Eduardo Cavazos)
|
||||||
|
- lisppaste -- Lisppaste XML-RPC demo (Slava Pestov)
|
||||||
|
- mandel -- Mandelbrot fractal demo (Slava Pestov)
|
||||||
|
- random-tester -- Random compiler tester (Doug Coleman)
|
||||||
|
- raytracer -- Raytracer demo (Slava Pestov)
|
||||||
|
- rss -- An RSS1, RSS2 and Atom parser and aggregator (Chris Double, Daniel Ehrenberg)
|
||||||
|
- show-dataflow -- Code to print compiler dataflow IR to the console, or show it in the UI (Slava Pestov)
|
||||||
|
- space-invaders -- Intel 8080-based Space Invaders arcade machine emulator (Chris Double)
|
||||||
|
- tetris -- Tetris game (Alex Chapman)
|
||||||
|
- turing -- Turing machine demo (Slava Pestov)
|
||||||
|
- wee-url -- Web app to make short URLs from long ones (Doug Coleman)
|
||||||
|
|
@ -0,0 +1,14 @@
|
||||||
|
USING: words kernel modules ;
|
||||||
|
|
||||||
|
REQUIRES: apps/automata apps/benchmarks apps/boids
|
||||||
|
apps/factorbot apps/furnace-fjsc apps/furnace-onigiri
|
||||||
|
apps/furnace-pastebin apps/help-lint apps/hexdump
|
||||||
|
apps/lindenmayer apps/lisppaste apps/mandel apps/random-tester
|
||||||
|
apps/raytracer apps/rss apps/space-invaders apps/tetris
|
||||||
|
apps/turing apps/show-dataflow apps/wee-url ;
|
||||||
|
|
||||||
|
"x11" vocab [
|
||||||
|
"apps/factory" require
|
||||||
|
] when
|
||||||
|
|
||||||
|
PROVIDE: apps/all ;
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
REQUIRES: contrib/vars contrib/slate contrib/lindenmayer/opengl ;
|
REQUIRES: libs/vars libs/slate apps/lindenmayer/opengl ;
|
||||||
|
|
||||||
USING: kernel namespaces hashtables sequences generic math arrays
|
USING: kernel namespaces hashtables sequences generic math arrays
|
||||||
threads opengl gadgets
|
threads opengl gadgets
|
||||||
|
|
@ -153,7 +153,7 @@ init
|
||||||
slate> over set-delegate
|
slate> over set-delegate
|
||||||
interesting random-item set-rule ;
|
interesting random-item set-rule ;
|
||||||
|
|
||||||
: automata-window ( -- ) <automata-gadget> "Automata" open-titled-window ;
|
: automata-window ( -- ) <automata-gadget> "Automata" open-window ;
|
||||||
|
|
||||||
automata-gadget H{
|
automata-gadget H{
|
||||||
{ T{ key-down f f "1" } [ slate-ns [ start-center ] bind ] }
|
{ T{ key-down f f "1" } [ slate-ns [ start-center ] bind ] }
|
||||||
|
|
@ -167,4 +167,4 @@ automata-gadget H{
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
PROVIDE: contrib/automata ;
|
PROVIDE: apps/automata ;
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
USING: gadgets-panes hashtables help io kernel namespaces
|
USING: gadgets-panes hashtables help io kernel namespaces
|
||||||
prettyprint sequences test threads words ;
|
prettyprint sequences errors threads words test ;
|
||||||
|
|
||||||
[
|
[
|
||||||
all-articles [
|
all-articles [
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
PROVIDE: contrib/benchmarks
|
PROVIDE: apps/benchmarks
|
||||||
{ +tests+ {
|
{ +tests+ {
|
||||||
"empty-loop.factor"
|
"empty-loop.factor"
|
||||||
"fac.factor"
|
"fac.factor"
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
REQUIRES: contrib/math
|
REQUIRES: libs/math
|
||||||
contrib/vars
|
libs/vars
|
||||||
contrib/lindenmayer/opengl
|
apps/lindenmayer/opengl
|
||||||
contrib/slate ;
|
libs/slate ;
|
||||||
|
|
||||||
USING: kernel namespaces math sequences arrays threads opengl gadgets
|
USING: kernel namespaces math sequences arrays threads opengl gadgets
|
||||||
math-contrib vars opengl-contrib slate ;
|
math-contrib vars opengl-contrib slate ;
|
||||||
|
|
@ -267,7 +267,7 @@ stop? get [ ] [ run ] if ;
|
||||||
<slate> >slate
|
<slate> >slate
|
||||||
namespace slate> set-slate-ns
|
namespace slate> set-slate-ns
|
||||||
[ display ] >action
|
[ display ] >action
|
||||||
slate> "Boids" open-titled-window ;
|
slate> "Boids" open-window ;
|
||||||
|
|
||||||
: init-boids ( -- ) 50 random-boids >boids ;
|
: init-boids ( -- ) 50 random-boids >boids ;
|
||||||
|
|
||||||
|
|
@ -275,4 +275,4 @@ slate> "Boids" open-titled-window ;
|
||||||
|
|
||||||
: init ( -- ) init-slate init-variables init-world-size init-boids stop? off ;
|
: init ( -- ) init-slate init-variables init-world-size init-boids stop? off ;
|
||||||
|
|
||||||
PROVIDE: contrib/boids ;
|
PROVIDE: apps/boids ;
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
! Simple IRC bot written in Factor.
|
! Simple IRC bot written in Factor.
|
||||||
|
|
||||||
REQUIRES: contrib/httpd ;
|
REQUIRES: libs/httpd ;
|
||||||
|
|
||||||
USING: errors generic hashtables help html http io kernel math
|
USING: errors generic hashtables help html http io kernel math
|
||||||
memory namespaces parser prettyprint sequences strings threads
|
memory namespaces parser prettyprint sequences strings threads
|
||||||
|
|
@ -76,7 +76,7 @@ M: ping handle-irc ( line -- )
|
||||||
: factorbot-loop [ factorbot ] try 30000 sleep factorbot-loop ;
|
: factorbot-loop [ factorbot ] try 30000 sleep factorbot-loop ;
|
||||||
|
|
||||||
: multiline-respond ( string -- )
|
: multiline-respond ( string -- )
|
||||||
<string-reader> lines [ respond ] each ;
|
string-lines [ respond ] each ;
|
||||||
|
|
||||||
: object-href
|
: object-href
|
||||||
"http://factorcode.org" swap browser-link-href append ;
|
"http://factorcode.org" swap browser-link-href append ;
|
||||||
|
|
@ -93,24 +93,16 @@ IN: factorbot-commands
|
||||||
] [
|
] [
|
||||||
nip [
|
nip [
|
||||||
dup summary " -- "
|
dup summary " -- "
|
||||||
rot object-href append3 respond
|
rot object-href 3append respond
|
||||||
] each
|
] each
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: memory ( text -- )
|
: memory ( text -- )
|
||||||
drop [ room. ] string-out multiline-respond ;
|
drop [ room. ] string-out multiline-respond ;
|
||||||
|
|
||||||
: search ( text -- )
|
|
||||||
search-help dup empty? [
|
|
||||||
not-found
|
|
||||||
] [
|
|
||||||
first first dup article-title
|
|
||||||
" -- " rot <link> object-href append3 respond
|
|
||||||
] if ;
|
|
||||||
|
|
||||||
: quit ( text -- )
|
: quit ( text -- )
|
||||||
drop speaker get "slava" = [ disconnect ] when ;
|
drop speaker get "slava" = [ disconnect ] when ;
|
||||||
|
|
||||||
PROVIDE: examples/factorbot ;
|
PROVIDE: apps/factorbot ;
|
||||||
|
|
||||||
MAIN: examples/factorbot factorbot ;
|
MAIN: apps/factorbot factorbot ;
|
||||||
|
|
@ -1,11 +1,3 @@
|
||||||
----------------------------------------------------------------------
|
|
||||||
Loading factory
|
|
||||||
----------------------------------------------------------------------
|
|
||||||
|
|
||||||
Putting factory into your image is as simple as this:
|
|
||||||
|
|
||||||
"contrib/factory" require save
|
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
Running factory in Xnest
|
Running factory in Xnest
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
|
|
@ -17,7 +9,7 @@ can use 2 or greater.
|
||||||
|
|
||||||
Start factor and launch factory on the appropriate display:
|
Start factor and launch factory on the appropriate display:
|
||||||
|
|
||||||
"contrib/factory" run-module
|
"libs/factory" run-module
|
||||||
|
|
||||||
In a terminal, start an application on the appropriate display:
|
In a terminal, start an application on the appropriate display:
|
||||||
|
|
||||||
|
|
@ -0,0 +1,7 @@
|
||||||
|
REQUIRES: libs/process libs/concurrency libs/x11 libs/vars ;
|
||||||
|
|
||||||
|
PROVIDE: apps/factory { +files+ { "factory.factor" } } ;
|
||||||
|
|
||||||
|
USE: factory
|
||||||
|
|
||||||
|
MAIN: apps/factory f start-factory ;
|
||||||
|
|
@ -0,0 +1,76 @@
|
||||||
|
! Copyright (C) 2006 Chris Double. All Rights Reserved.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
!
|
||||||
|
IN: furnace:fjsc
|
||||||
|
USING: kernel html furnace xml xml-writer io httpd sequences
|
||||||
|
namespaces file-responder parser-combinators lazy-lists
|
||||||
|
fjsc ;
|
||||||
|
|
||||||
|
: script ( path -- )
|
||||||
|
#! given a path to a javascript file, output the
|
||||||
|
#! script tag that references it.
|
||||||
|
<script "text/javascript" =type =src script> </script> ;
|
||||||
|
|
||||||
|
: fjsc-page ( scripts title quot -- )
|
||||||
|
#! Display a web page importing the given script
|
||||||
|
#! tags and using the title. The body of the page
|
||||||
|
#! is generated by calling the quotation.
|
||||||
|
-rot xhtml-preamble
|
||||||
|
chars>entities
|
||||||
|
<html " xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\"" write-html html>
|
||||||
|
<head>
|
||||||
|
<title> write </title>
|
||||||
|
[ script ] each
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
call
|
||||||
|
</body>
|
||||||
|
</html> ;
|
||||||
|
|
||||||
|
: fjsc-render ( template title -- )
|
||||||
|
#! Render the fjsc page importing the required
|
||||||
|
#! scripts.
|
||||||
|
serving-html {
|
||||||
|
"/responder/fjsc-resources/jquery.js"
|
||||||
|
"/responder/fjsc-resources/bootstrap.js"
|
||||||
|
} swap [
|
||||||
|
[
|
||||||
|
f swap render-template
|
||||||
|
] fjsc-page
|
||||||
|
] with-html-stream ;
|
||||||
|
|
||||||
|
: compile ( code -- )
|
||||||
|
#! Compile the facor code as a string, outputting the http
|
||||||
|
#! response containing the javascript.
|
||||||
|
serving-text
|
||||||
|
'expression' parse car parse-result-parsed fjsc-compile
|
||||||
|
write flush ;
|
||||||
|
|
||||||
|
! The 'compile' action results in an URL that looks like
|
||||||
|
! 'responder/fjsc/compile'. It takes one query or post
|
||||||
|
! parameter called 'code'. It calls the 'compile' word
|
||||||
|
! passing the parameter to it on the stack.
|
||||||
|
\ compile {
|
||||||
|
{ "code" v-required }
|
||||||
|
} define-action
|
||||||
|
|
||||||
|
: repl ( -- )
|
||||||
|
#! The main 'repl' page.
|
||||||
|
f "repl" "Factor to Javascript REPL" fjsc-render ;
|
||||||
|
|
||||||
|
! An action called 'repl'
|
||||||
|
\ repl { } define-action
|
||||||
|
|
||||||
|
! Create the web app, providing access
|
||||||
|
! under '/responder/fjsc' which calls the
|
||||||
|
! 'repl' action.
|
||||||
|
"fjsc" "repl" "apps/furnace-fjsc" web-app
|
||||||
|
|
||||||
|
! An URL to the javascript resource files used by
|
||||||
|
! the 'fjsc' responder.
|
||||||
|
"fjsc-resources" [
|
||||||
|
[
|
||||||
|
"libs/fjsc/resources/" resource-path "doc-root" set
|
||||||
|
file-responder
|
||||||
|
] with-scope
|
||||||
|
] add-simple-responder
|
||||||
|
|
@ -0,0 +1,14 @@
|
||||||
|
! Copyright (C) 2006 Chris Double. All Rights Reserved.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
!
|
||||||
|
REQUIRES: libs/furnace libs/fjsc ;
|
||||||
|
|
||||||
|
PROVIDE: apps/furnace-fjsc
|
||||||
|
{
|
||||||
|
+files+ {
|
||||||
|
"furnace-fjsc.factor"
|
||||||
|
}
|
||||||
|
} {
|
||||||
|
+tests+ {
|
||||||
|
}
|
||||||
|
} ;
|
||||||
|
|
@ -0,0 +1,41 @@
|
||||||
|
<table border="0">
|
||||||
|
<tr><td valign="top">
|
||||||
|
<p><b>Enter Factor Code Here</b></p>
|
||||||
|
<form id="toeval" onsubmit="factor.server_eval($('#code').get(0).value);return false;" method="post">
|
||||||
|
<textarea name="code" id="code" cols="64" rows="5">
|
||||||
|
</textarea>
|
||||||
|
<input type="submit" value="Compile"/>
|
||||||
|
</form>
|
||||||
|
<h3>Compiled Code</h3>
|
||||||
|
<textarea id="compiled" cols="64" rows="3">
|
||||||
|
</textarea>
|
||||||
|
<p><b>Stack</b></p>
|
||||||
|
<div id="stack">
|
||||||
|
</div>
|
||||||
|
<p><b>Playground</b></p>
|
||||||
|
<div id="playground">
|
||||||
|
</div>
|
||||||
|
</td>
|
||||||
|
<td valign="top">
|
||||||
|
<p>More information on the Factor to Javascript compiler can be found at these blog posts:
|
||||||
|
<ul>
|
||||||
|
<li><a href="http://www.bluishcoder.co.nz/2006/12/compiling-factor-to-javascript.html">Factor to Javascript Compiler</a></li>
|
||||||
|
<li><a href="http://www.bluishcoder.co.nz/2006/12/factor-to-javascript-compiler-updates.html">Factor to Javascript Compiler Updates</a></li>
|
||||||
|
<li><a href="http://www.bluishcoder.co.nz/2006/12/continuations-added-to-fjsc.html">Continuations added to fjsc</a></li>
|
||||||
|
<li><a href="http://www.bluishcoder.co.nz/2006/12/cross-domain-json-with-fjsc.html">Cross Domain JSON with fjsc</a></li>
|
||||||
|
</ul>
|
||||||
|
</p>
|
||||||
|
<p>Some useful words:
|
||||||
|
<dl>
|
||||||
|
<dt>vocabs ( -- seq )</dt>
|
||||||
|
<dd>Return a sequence of available vocabularies</dd>
|
||||||
|
<dt>words ( string -- seq )</dt>
|
||||||
|
<dd>Return a sequence of words in the given vocabulary</dd>
|
||||||
|
<dt>all-words ( -- seq )</dt>
|
||||||
|
<dd>Return a sequence of all words</dd>
|
||||||
|
</dl>
|
||||||
|
</p>
|
||||||
|
<p>The contents of <a href="/responder/fjsc-resources/bootstrap.factor">bootstrap.factor</a> have been loaded on startup.</p>
|
||||||
|
</td>
|
||||||
|
</tr>
|
||||||
|
</table>
|
||||||
|
|
@ -0,0 +1,11 @@
|
||||||
|
! Copyright (C) 2006 Matthew Willis. All Rights Reserved.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
!
|
||||||
|
REQUIRES: libs/furnace libs/sqlite libs/calendar libs/crypto libs/farkup
|
||||||
|
libs/basic-authentication ;
|
||||||
|
|
||||||
|
PROVIDE: apps/furnace-onigiri
|
||||||
|
{ +files+ {
|
||||||
|
"onigiri.factor"
|
||||||
|
"onigiri.facts"
|
||||||
|
} } ;
|
||||||
|
|
@ -0,0 +1,278 @@
|
||||||
|
! Copyright (C) 2006 Matthew Willis. All Rights Reserved.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
!
|
||||||
|
USING: httpd threads kernel namespaces furnace sqlite tuple-db
|
||||||
|
sequences html strings math hashtables crypto io file-responder calendar
|
||||||
|
prettyprint parser errors sha2 basic-authentication ;
|
||||||
|
|
||||||
|
IN: furnace:onigiri
|
||||||
|
|
||||||
|
! start should be removed after doublec's responder-url hits the main repos
|
||||||
|
SYMBOL: responder-url
|
||||||
|
"/" responder-url set
|
||||||
|
! end
|
||||||
|
|
||||||
|
TUPLE: entry title stub body created updated ;
|
||||||
|
entry default-mapping set-mapping
|
||||||
|
|
||||||
|
: any-entry ( -- entry )
|
||||||
|
! useful for tuple-db searching
|
||||||
|
f f f f f <entry> ;
|
||||||
|
|
||||||
|
TUPLE: onigiri-meta value key ;
|
||||||
|
onigiri-meta default-mapping set-mapping
|
||||||
|
|
||||||
|
TUPLE: user name password level ;
|
||||||
|
user default-mapping set-mapping
|
||||||
|
|
||||||
|
DEFER: onigiri
|
||||||
|
: setup-entries ( db-name -- )
|
||||||
|
! create the entries table
|
||||||
|
sqlite-open dup entry create-tuple-table sqlite-close ;
|
||||||
|
|
||||||
|
: setup-meta ( port db-name -- )
|
||||||
|
! create the onigiri metadata table
|
||||||
|
! the port data is necessary, all other data must be entered manually
|
||||||
|
! until we get the CRUD interface
|
||||||
|
sqlite-open [ onigiri-meta create-tuple-table ] keep
|
||||||
|
swap dupd number>string "port" <onigiri-meta> save-tuple sqlite-close ;
|
||||||
|
|
||||||
|
: setup-users ( db-name -- )
|
||||||
|
! create the users table, adding a default admin user with password admin
|
||||||
|
sqlite-open dup user create-tuple-table dup
|
||||||
|
"admin" dup string>sha-256-string over <user> save-tuple sqlite-close ;
|
||||||
|
|
||||||
|
: load-onigiri-meta ( -- )
|
||||||
|
"db" \ onigiri get hash
|
||||||
|
f f <onigiri-meta> find-tuples
|
||||||
|
[
|
||||||
|
dup onigiri-meta-value swap onigiri-meta-key
|
||||||
|
\ onigiri get set-hash
|
||||||
|
] each ;
|
||||||
|
|
||||||
|
: remove-onigiri-meta ( -- )
|
||||||
|
! probably shouldn't use this directly
|
||||||
|
"db" \ onigiri get hash dup f f <onigiri-meta> find-tuples
|
||||||
|
[ delete-tuple ] each-with ;
|
||||||
|
|
||||||
|
: save-onigiri-meta ( -- )
|
||||||
|
remove-onigiri-meta
|
||||||
|
"db" \ onigiri get [ hash ] keep hash-keys
|
||||||
|
[
|
||||||
|
dup \ onigiri get hash dup string?
|
||||||
|
[ swap <onigiri-meta> save-tuple ]
|
||||||
|
[ 3drop ] if
|
||||||
|
] each-with ;
|
||||||
|
|
||||||
|
: title>stub ( title -- stub )
|
||||||
|
! creates a url friendly name based on the title
|
||||||
|
" " split [ [ alpha? ] subset ] map "" swap remove "-" join ;
|
||||||
|
|
||||||
|
: action>url ( action -- url )
|
||||||
|
responder-url get swap append ;
|
||||||
|
|
||||||
|
: stub>url ( stub -- url )
|
||||||
|
"entry-show?entry=" swap append action>url ;
|
||||||
|
|
||||||
|
: stub>entry ( stub -- entry )
|
||||||
|
[
|
||||||
|
"db" \ onigiri get hash swap any-entry [ set-entry-stub ] keep
|
||||||
|
find-tuples dup empty? [ drop f ] [ first ] if
|
||||||
|
] [ f ] if* ;
|
||||||
|
|
||||||
|
: name>user ( name -- user )
|
||||||
|
[
|
||||||
|
"db" \ onigiri get hash swap f f <user> find-tuples
|
||||||
|
dup empty? [ drop f ] [ first ] if
|
||||||
|
] [ f ] if* ;
|
||||||
|
|
||||||
|
: key>meta ( key -- onigiri-meta )
|
||||||
|
[
|
||||||
|
"db" \ onigiri get hash f rot <onigiri-meta> find-tuples
|
||||||
|
dup empty? [ drop f ] [ first ] if
|
||||||
|
] [ f ] if* ;
|
||||||
|
|
||||||
|
: compose-entry ( title body-lines -- )
|
||||||
|
"\n" join over title>stub swap
|
||||||
|
millis number>string dup <entry>
|
||||||
|
"db" \ onigiri get hash swap insert-tuple ;
|
||||||
|
|
||||||
|
: millis>timestamp ( millis -- timestamp )
|
||||||
|
1000 /f seconds unix-1970 swap +dt ;
|
||||||
|
|
||||||
|
: atom ( -- )
|
||||||
|
"text/xml" serving-content
|
||||||
|
f "atom" render-template ;
|
||||||
|
|
||||||
|
: css-path ( -- path )
|
||||||
|
! "text/css" serving-content
|
||||||
|
"css" \ onigiri get hash [ "onigirihouse" ] unless*
|
||||||
|
"apps/furnace-onigiri/resources/" swap ".css" 3append resource-path ;
|
||||||
|
|
||||||
|
: css ( -- )
|
||||||
|
"text/css" serving-content css-path [
|
||||||
|
[
|
||||||
|
file-vocabs
|
||||||
|
dup file set ! so that reload works properly
|
||||||
|
dup <file-reader> contents write
|
||||||
|
] with-scope
|
||||||
|
] assert-depth drop ;
|
||||||
|
|
||||||
|
TUPLE: onigiri-layout title quot ;
|
||||||
|
: onigiri-document ( title quot -- )
|
||||||
|
<onigiri-layout> "front" render-template ;
|
||||||
|
|
||||||
|
: entry-list ( -- )
|
||||||
|
"title" \ onigiri get hash
|
||||||
|
serving-html [
|
||||||
|
[
|
||||||
|
"db" \ onigiri get hash any-entry find-tuples
|
||||||
|
[ [ entry-created string>number ] 2apply <=> neg ] sort
|
||||||
|
[ "entry" render-template ] each
|
||||||
|
] onigiri-document
|
||||||
|
] with-html-stream ;
|
||||||
|
|
||||||
|
: entry-show ( stub -- )
|
||||||
|
stub>entry
|
||||||
|
[
|
||||||
|
dup "title" \ onigiri get hash
|
||||||
|
" - " rot entry-title 3append swap
|
||||||
|
serving-html [
|
||||||
|
[
|
||||||
|
"entry" render-template
|
||||||
|
] curry onigiri-document
|
||||||
|
] with-html-stream
|
||||||
|
] [
|
||||||
|
"title" \ onigiri get hash " - Entry not found" append
|
||||||
|
serving-html [
|
||||||
|
[ f "no-entry" render-template ] onigiri-document
|
||||||
|
] with-html-stream
|
||||||
|
] if* ;
|
||||||
|
|
||||||
|
: entry-edit ( stub -- )
|
||||||
|
[
|
||||||
|
any-entry [ set-entry-stub ] keep "db" \ onigiri get hash
|
||||||
|
swap find-tuples dup length zero?
|
||||||
|
[ drop any-entry "new entry"] [ first dup entry-title ] if
|
||||||
|
] [ any-entry "new entry" ] if*
|
||||||
|
"title" \ onigiri get hash " - editing " append swap append
|
||||||
|
serving-html swap [
|
||||||
|
[
|
||||||
|
"edit" render-template
|
||||||
|
] curry onigiri-document
|
||||||
|
] with-html-stream ;
|
||||||
|
|
||||||
|
: entry-update ( body title stub -- )
|
||||||
|
"onigiri-users" [
|
||||||
|
[
|
||||||
|
stub>entry [ any-entry ] unless*
|
||||||
|
] [ any-entry over title>stub swap [ set-entry-stub ] keep ] if*
|
||||||
|
[ set-entry-title ] keep
|
||||||
|
[ CHAR: \r rot remove swap set-entry-body ] keep
|
||||||
|
millis number>string swap [ set-entry-updated ] 2keep
|
||||||
|
dup entry-created [ nip ] [ [ set-entry-created ] keep ] if
|
||||||
|
"db" \ onigiri get hash swap [ save-tuple ] keep
|
||||||
|
entry-stub "entry-show?entry=" swap append permanent-redirect
|
||||||
|
] with-basic-authentication ;
|
||||||
|
|
||||||
|
: entry-delete ( stub -- )
|
||||||
|
"onigiri-users" [
|
||||||
|
stub>entry [
|
||||||
|
"db" \ onigiri get hash swap delete-tuple
|
||||||
|
] when*
|
||||||
|
"entry-list" permanent-redirect
|
||||||
|
] with-basic-authentication ;
|
||||||
|
|
||||||
|
: user-list ( -- )
|
||||||
|
"onigiri-users" [
|
||||||
|
serving-html [
|
||||||
|
f "admin-header" render-template
|
||||||
|
f "user-list" render-template
|
||||||
|
f "admin-footer" render-template
|
||||||
|
] with-html-stream
|
||||||
|
] with-basic-authentication ;
|
||||||
|
|
||||||
|
: user-edit ( name -- )
|
||||||
|
"onigiri-users" [
|
||||||
|
serving-html [
|
||||||
|
f "admin-header" render-template
|
||||||
|
dup [ name>user nip ] when* "user-edit" render-template
|
||||||
|
f "admin-footer" render-template
|
||||||
|
] with-html-stream
|
||||||
|
] with-basic-authentication ;
|
||||||
|
|
||||||
|
: user-update ( name password level -- )
|
||||||
|
"onigiri-admin" [
|
||||||
|
pick name>user
|
||||||
|
[
|
||||||
|
tuck set-user-level swap string>sha-256-string over
|
||||||
|
set-user-password nip
|
||||||
|
]
|
||||||
|
[ swap string>sha-256-string swap <user> ] if*
|
||||||
|
"db" \ onigiri get hash swap save-tuple
|
||||||
|
"user-list" permanent-redirect
|
||||||
|
] with-basic-authentication ;
|
||||||
|
|
||||||
|
: user-delete ( name -- )
|
||||||
|
"onigiri-admin" [
|
||||||
|
name>user [ "db" \ onigiri get hash swap delete-tuple ] when*
|
||||||
|
"user-list" permanent-redirect
|
||||||
|
] with-basic-authentication ;
|
||||||
|
|
||||||
|
: meta-list ( -- )
|
||||||
|
"onigiri-users" [
|
||||||
|
serving-html [
|
||||||
|
f "admin-header" render-template
|
||||||
|
f "meta-list" render-template
|
||||||
|
f "admin-footer" render-template
|
||||||
|
] with-html-stream
|
||||||
|
] with-basic-authentication ;
|
||||||
|
|
||||||
|
: meta-update ( value key -- )
|
||||||
|
"onigiri-admin" [
|
||||||
|
\ onigiri get set-hash "meta-list" permanent-redirect
|
||||||
|
] with-basic-authentication ;
|
||||||
|
|
||||||
|
: register-actions ( -- )
|
||||||
|
\ entry-list { } define-action
|
||||||
|
\ entry-show { { "entry" } } define-action
|
||||||
|
\ entry-edit { { "entry" } } define-action
|
||||||
|
\ entry-update { { "body" } { "title" } { "stub" } } define-action
|
||||||
|
\ entry-delete { { "entry" } } define-action
|
||||||
|
\ user-list { } define-action
|
||||||
|
\ user-edit { { "name" } } define-action
|
||||||
|
\ user-update { { "name" } { "password" } { "level" } } define-action
|
||||||
|
\ user-delete { { "name" } } define-action
|
||||||
|
\ meta-list { } define-action
|
||||||
|
\ meta-update { { "value" } { "key" } } define-action
|
||||||
|
\ atom { } define-action
|
||||||
|
\ css { } define-action
|
||||||
|
"onigiri" "entry-list" "apps/furnace-onigiri/templates/" web-app ;
|
||||||
|
|
||||||
|
: setup-onigiri ( port db-name -- )
|
||||||
|
tuck setup-meta dup setup-entries setup-users ;
|
||||||
|
|
||||||
|
: stop-onigiri ( -- )
|
||||||
|
! save metadata, close the db, remove the onigirihouse responder,
|
||||||
|
! and if it was the default responder, make "file" the default responder
|
||||||
|
save-onigiri-meta
|
||||||
|
"db" \ onigiri get hash sqlite-close
|
||||||
|
"onigiri" responders get remove-hash
|
||||||
|
"responder" "default" responders get hash hash
|
||||||
|
"onigiri" = [ "file" set-default-responder ] when ;
|
||||||
|
|
||||||
|
: onigiri ( db-name -- )
|
||||||
|
! open the db, load metadata from the db, start httpd [optionally,
|
||||||
|
! with onigiri as the default responder]
|
||||||
|
H{ } clone \ onigiri set
|
||||||
|
sqlite-open "db" \ onigiri get set-hash
|
||||||
|
load-onigiri-meta register-actions
|
||||||
|
"onigiri-as-default-responder" \ onigiri get hash "true" =
|
||||||
|
[ "onigiri" set-default-responder ] when
|
||||||
|
"port" \ onigiri get hash string>number [ httpd ] in-thread drop
|
||||||
|
! add the onigiri users realm
|
||||||
|
[ f <user> "db" \ onigiri get hash swap find-tuples empty? not ]
|
||||||
|
"onigiri-users" add-realm
|
||||||
|
! add the onigiri admins realm
|
||||||
|
[ "admin" <user> "db" \ onigiri get hash swap find-tuples empty? not ]
|
||||||
|
"onigiri-admin" add-realm ;
|
||||||
|
|
@ -0,0 +1,38 @@
|
||||||
|
Better xhtml structure
|
||||||
|
Adsense
|
||||||
|
*UI for metadata
|
||||||
|
Plugins
|
||||||
|
Themes
|
||||||
|
Recent posts sidebar
|
||||||
|
Links sidebar
|
||||||
|
Widgets (Onigirihouse feels ...)
|
||||||
|
Tagging
|
||||||
|
Pretty URL's
|
||||||
|
Develop protocol for metadata and their defaults
|
||||||
|
Use wiky to do client-side wikistyle
|
||||||
|
Change furnace to /controller/action/argument1/argument2/.../ style
|
||||||
|
Have posts correlated with users
|
||||||
|
Figure out which user is logged in from inside an action
|
||||||
|
|
||||||
|
----DONE-----
|
||||||
|
|
||||||
|
by 12/31/2006
|
||||||
|
Atom
|
||||||
|
Individual post pages
|
||||||
|
Timestamping and ordering
|
||||||
|
Rename onigirihouse => onigiri
|
||||||
|
Store blog metadata in db
|
||||||
|
Markdown for entries
|
||||||
|
Make Atom feed validate (Add id, updated to atom)
|
||||||
|
Store URL
|
||||||
|
UI for posting
|
||||||
|
Posting interface
|
||||||
|
Switch to plug-in CSS
|
||||||
|
|
||||||
|
1/1/07
|
||||||
|
Stopped using farkup (for now)
|
||||||
|
Moved to controller-action naming convention
|
||||||
|
|
||||||
|
1/2/07
|
||||||
|
Added Users
|
||||||
|
Added CRUD for Users, multiple levels of users
|
||||||
|
|
@ -0,0 +1,7 @@
|
||||||
|
body { font: 14px "Trebuchet MS", Arial, Helvetica, sans-serif; }
|
||||||
|
h1, h2, h3, h4, h5, h6 { font-family: lucida grande ; }
|
||||||
|
#header { text-align: center ; }
|
||||||
|
#container { max-width: 720px ; margin: 0 auto; padding: 20px; }
|
||||||
|
.entry { margin-bottom: 75px ; }
|
||||||
|
a { color: #5C832F; text-decoration: none; }
|
||||||
|
a:hover { text-decoration: underline; }
|
||||||
|
|
@ -0,0 +1,3 @@
|
||||||
|
</div>
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
|
|
@ -0,0 +1,15 @@
|
||||||
|
<?xml version="1.0"?><!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
|
||||||
|
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
|
||||||
|
<head>
|
||||||
|
<% USING: namespaces io kernel hashtables furnace:onigiri furnace ; %>
|
||||||
|
<title>Onigiri Admin</title>
|
||||||
|
<link rel='stylesheet' type='text/css' href='<% "css" action>url write %>'/>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
|
||||||
|
<div id="header">
|
||||||
|
<h1><% "title" \ onigiri get hash write %> Admin</h1>
|
||||||
|
<p><a href="<% "entry-list" action>url write %>">Main Page</a> | <a href="<% "entry-edit" action>url write %>">Post</a> | <a href="<% "meta-list" action>url write %>">Meta</a> | <a href="<% "user-list" action>url write %>">Users</a></p>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div id="container">
|
||||||
|
|
@ -0,0 +1,8 @@
|
||||||
|
<% USING: io namespaces hashtables furnace:onigiri ; %>
|
||||||
|
|
||||||
|
<script src="http://www.google-analytics.com/urchin.js" type="text/javascript">
|
||||||
|
</script>
|
||||||
|
<script type="text/javascript">
|
||||||
|
_uacct = "<% "analytics" \ onigiri get hash write %>";
|
||||||
|
urchinTracker();
|
||||||
|
</script>
|
||||||
|
|
@ -0,0 +1,24 @@
|
||||||
|
<?xml version="1.0" encoding="utf-8"?>
|
||||||
|
<feed xmlns="http://www.w3.org/2005/Atom">
|
||||||
|
<% USING: io namespaces httpd furnace:onigiri tuple-db
|
||||||
|
math kernel sequences hashtables html calendar ; %>
|
||||||
|
<title><% "title" \ onigiri get hash write %></title>
|
||||||
|
<link rel="self" href="<% "atom" action>url write %>"/>
|
||||||
|
<author>
|
||||||
|
<name><% "author" \ onigiri get hash write %></name>
|
||||||
|
</author>
|
||||||
|
<id><% "atom" action>url write %></id>
|
||||||
|
<% "db" \ onigiri get hash any-entry find-tuples
|
||||||
|
[ [ entry-updated string>number ] 2apply <=> neg ] sort
|
||||||
|
dup empty? [ %>
|
||||||
|
<updated><% dup first entry-updated string>number millis>timestamp timestamp>rfc3339 write %></updated><% ] unless
|
||||||
|
[ [ entry-created string>number ] 2apply <=> neg ] sort
|
||||||
|
[ %>
|
||||||
|
<entry>
|
||||||
|
<title><% dup entry-title write %></title>
|
||||||
|
<id><% dup entry-stub stub>url dup write %></id>
|
||||||
|
<updated><% over entry-updated string>number millis>timestamp timestamp>rfc3339 write %></updated>
|
||||||
|
<link href="<% write %>"/>
|
||||||
|
<summary><% entry-body write %></summary>
|
||||||
|
</entry><% ] each %>
|
||||||
|
</feed>
|
||||||
|
|
@ -0,0 +1,9 @@
|
||||||
|
<% USING: namespaces io kernel sequences furnace:onigiri ; %>
|
||||||
|
|
||||||
|
<form method="post" action="entry-update">
|
||||||
|
<% "stub" get [ %><input type="hidden" name="stub" value="<% "stub" get write %>"/><% ] when %>
|
||||||
|
<table><tr><td>Title:</td><td><input type="text" name="title" value="<% "title" get write %>"/></td></tr>
|
||||||
|
<tr><td>Body:</td><td><textarea rows="15" cols="80" name="body"><% "body" get write %></textarea></td></tr>
|
||||||
|
<tr><td><input type="submit" name="post" value="<% "stub" get "update" "post" ? write %>"/></td><% "stub" get [ %><td><a href="<% "entry-delete?entry=" "stub" get append action>url write %>">Delete</a></td><% ] when %></tr>
|
||||||
|
</table>
|
||||||
|
</form>
|
||||||
|
|
@ -0,0 +1,10 @@
|
||||||
|
<% USING: furnace:onigiri io namespaces math calendar html kernel ; %>
|
||||||
|
|
||||||
|
<div class="entry">
|
||||||
|
<h2><a href="<% "stub" get stub>url write %>"><% "title" get write %></a></h2>
|
||||||
|
|
||||||
|
<p>posted <% "created" get string>number 1000 /f seconds
|
||||||
|
unix-1970 swap +dt >local-time timestamp>string write %> <a href="entry-edit?entry=<% "stub" get write %>">(edit)</a></p>
|
||||||
|
|
||||||
|
<% "body" get write-html %>
|
||||||
|
</div>
|
||||||
|
|
@ -0,0 +1,25 @@
|
||||||
|
<?xml version="1.0"?><!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
|
||||||
|
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
|
||||||
|
<head>
|
||||||
|
<% USING: namespaces io kernel hashtables furnace:onigiri furnace ; %>
|
||||||
|
<title><% "title" get write %></title>
|
||||||
|
<link rel='stylesheet' type='text/css' href='<% "css" action>url write %>'/>
|
||||||
|
<script type='text/javascript' src='/responder/resources/prototype.js'></script>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
|
||||||
|
<div id="header">
|
||||||
|
<h1><a href="<% "entry-list" action>url write %>"><% "title" \ onigiri get hash write %></a></h1>
|
||||||
|
|
||||||
|
<p>Proudly running on <a href="http://factorcode.org">Factor <% version write %></a></p>
|
||||||
|
|
||||||
|
<p><a href="http://validator.w3.org/check?uri=referer">Valid XHTML 1.0 Strict</a> | <a href="<% "atom" action>url write %>">Subscribe to <% "title" \ onigiri get hash write %></a> | <a href="<% "user-list" action>url write %>">Admin</a> | <a href="<% "entry-edit" action>url write %>">Post</a></p>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div id="container">
|
||||||
|
<% "quot" get call %>
|
||||||
|
|
||||||
|
<% "analytics" \ onigiri get hash [ f "analytics" render-template ] when %>
|
||||||
|
</div>
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
|
|
@ -0,0 +1,22 @@
|
||||||
|
<% USING: furnace:onigiri namespaces hashtables sequences kernel strings io ; %>
|
||||||
|
|
||||||
|
<h3>Add/Change Onigiri Metadata</h3>
|
||||||
|
|
||||||
|
<table>
|
||||||
|
<tr><th>Key</th><th>Value</th></tr>
|
||||||
|
|
||||||
|
<form action="meta-update" method="post">
|
||||||
|
<tr><td><input type="text" name="key"/></td><td><input type="text" name="value"/></td><td><input type="submit" name="update" value="update"/></td></tr>
|
||||||
|
</form>
|
||||||
|
|
||||||
|
<% \ onigiri get hash-keys [ %>
|
||||||
|
|
||||||
|
<% dup \ onigiri get hash dup string? [ %>
|
||||||
|
|
||||||
|
<tr><td><% swap write %></td><td><% write %></td></tr>
|
||||||
|
|
||||||
|
<% ] [ 2drop ] if %>
|
||||||
|
|
||||||
|
<% ] each %>
|
||||||
|
|
||||||
|
</table>
|
||||||
|
|
@ -0,0 +1,5 @@
|
||||||
|
<% USING: furnace:onigiri io hashtables namespaces ; %>
|
||||||
|
|
||||||
|
<p>The entry you are searching for could not be found.</p>
|
||||||
|
|
||||||
|
<p><a href="<% "" action>url write %>">Back to <% "title" \ onigiri get hash write %></a></p>
|
||||||
|
|
@ -0,0 +1,15 @@
|
||||||
|
<% USING: furnace:onigiri namespaces io kernel ; %>
|
||||||
|
|
||||||
|
<form action="<% "user-update" action>url write %>" method=post>
|
||||||
|
<table>
|
||||||
|
<tr><td>Name:</td><td><input type="text" name="name" value="<% "name" get write %>"/></td></tr>
|
||||||
|
<tr><td>Password:</td><td><input type="password" name="password"/></td></tr>
|
||||||
|
|
||||||
|
<tr><td>Level:</td>
|
||||||
|
<td><select name="level">
|
||||||
|
<option value="user" <% "level" get "user" = [ "selected" write ] when %>>User</option>
|
||||||
|
<option value="admin" <% "level" get "admin" = [ "selected" write ] when %>>Admin</option></select></td></tr>
|
||||||
|
|
||||||
|
<tr><td><input type="submit" name="submit" value="submit"/></td></tr>
|
||||||
|
</table>
|
||||||
|
</form>
|
||||||
|
|
@ -0,0 +1,15 @@
|
||||||
|
<% USING: furnace:onigiri namespaces io hashtables tuple-db kernel sequences ; %>
|
||||||
|
|
||||||
|
<table>
|
||||||
|
<tr><th>Name</th><th>Level</th></tr>
|
||||||
|
|
||||||
|
<% "db" \ onigiri get hash f f f <user> find-tuples [ %>
|
||||||
|
<tr><td><% dup user-name write %></td>
|
||||||
|
<td><% dup user-level write %></td>
|
||||||
|
<td><a href="<% dup user-name "user-edit?name=" swap append action>url write %>">edit</a></td>
|
||||||
|
<td><a href="<% user-name "user-delete?name=" swap append action>url write %>">delete</a></td></tr>
|
||||||
|
<% ] each %>
|
||||||
|
|
||||||
|
</table>
|
||||||
|
|
||||||
|
<p><a href="<% "user-edit" action>url write %>">Add New User</a></p>
|
||||||
|
|
@ -0,0 +1,4 @@
|
||||||
|
REQUIRES: libs/furnace ;
|
||||||
|
|
||||||
|
PROVIDE: apps/furnace-pastebin
|
||||||
|
{ +files+ { "pastebin.factor" } } ;
|
||||||
|
|
@ -72,4 +72,4 @@ C: pastebin ( -- pastebin )
|
||||||
|
|
||||||
\ annotate-paste [ "n" show-paste ] define-redirect
|
\ annotate-paste [ "n" show-paste ] define-redirect
|
||||||
|
|
||||||
"pastebin" "paste-list" "contrib/furnace-pastebin" web-app
|
"pastebin" "paste-list" "apps/furnace-pastebin" web-app
|
||||||
|
|
@ -0,0 +1,115 @@
|
||||||
|
! Copyright (C) 2006 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
IN: help-lint
|
||||||
|
USING: sequences parser kernel errors help words modules strings
|
||||||
|
namespaces io prettyprint tools definitions generic ;
|
||||||
|
|
||||||
|
! A quick and dirty tool to check documentation in an automated
|
||||||
|
! fashion.
|
||||||
|
|
||||||
|
! - ensures examples run and produce stated output
|
||||||
|
! - ensures $see-also elements don't contain duplicate entries
|
||||||
|
! (I always make this mistake!)
|
||||||
|
! - ensures $module-link elements point to modules which
|
||||||
|
! actually exist
|
||||||
|
! - ensures that $values match the stack effect declaration
|
||||||
|
! - ensures that word help articles render (this catches broken
|
||||||
|
! links, improper nesting, etc)
|
||||||
|
|
||||||
|
: check-example ( element -- )
|
||||||
|
1 tail
|
||||||
|
[ 1 head* "\n" join eval>string "\n" ?tail drop ] keep
|
||||||
|
peek assert= ;
|
||||||
|
|
||||||
|
: check-examples ( word element -- )
|
||||||
|
nip \ $example swap elements [ check-example ] each ;
|
||||||
|
|
||||||
|
: extract-values ( element -- seq )
|
||||||
|
\ $values swap elements dup empty? [
|
||||||
|
drop { }
|
||||||
|
] [
|
||||||
|
first 1 tail [ first ] map prune natural-sort
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
: effect-values ( word -- seq )
|
||||||
|
stack-effect dup effect-in swap effect-out
|
||||||
|
append [ string? ] subset prune natural-sort ;
|
||||||
|
|
||||||
|
: check-values ( word element -- )
|
||||||
|
\ $shuffle over elements empty?
|
||||||
|
\ $values-x/y over elements empty? not and
|
||||||
|
pick "declared-effect" word-prop and [
|
||||||
|
extract-values >r effect-values r> assert=
|
||||||
|
] [
|
||||||
|
2drop
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
: check-see-also ( word element -- )
|
||||||
|
nip \ $see-also swap elements [
|
||||||
|
1 tail dup prune [ length ] 2apply assert=
|
||||||
|
] each ;
|
||||||
|
|
||||||
|
: check-modules ( word element -- )
|
||||||
|
nip \ $module-link swap elements [
|
||||||
|
second
|
||||||
|
\ available-modules get member?
|
||||||
|
[ "Missing module" throw ] unless
|
||||||
|
] each ;
|
||||||
|
|
||||||
|
: check-rendering ( word element -- )
|
||||||
|
drop [ help ] string-out drop ;
|
||||||
|
|
||||||
|
: all-word-help ( -- seq )
|
||||||
|
all-words [ word-help ] subset ;
|
||||||
|
|
||||||
|
TUPLE: word-help-error word ;
|
||||||
|
|
||||||
|
C: word-help-error
|
||||||
|
[ set-delegate ] keep
|
||||||
|
[ set-word-help-error-word ] keep ;
|
||||||
|
|
||||||
|
DEFER: check-help
|
||||||
|
|
||||||
|
: fix-help ( error -- )
|
||||||
|
dup delegate error.
|
||||||
|
word-help-error-word <link> edit
|
||||||
|
"Press ENTER when done." print flush readln drop
|
||||||
|
reload-modules
|
||||||
|
check-help ;
|
||||||
|
|
||||||
|
: check-1 ( word -- )
|
||||||
|
[
|
||||||
|
dup word-help [
|
||||||
|
2dup check-examples
|
||||||
|
2dup check-values
|
||||||
|
2dup check-see-also
|
||||||
|
2dup check-modules
|
||||||
|
2dup check-rendering
|
||||||
|
] assert-depth 2drop
|
||||||
|
] [
|
||||||
|
<word-help-error> throw
|
||||||
|
] recover ;
|
||||||
|
|
||||||
|
: check-help ( -- )
|
||||||
|
[
|
||||||
|
[
|
||||||
|
available-modules [ module-name ] map
|
||||||
|
\ available-modules set
|
||||||
|
all-word-help [ check-1 ] each
|
||||||
|
] with-scope
|
||||||
|
] [
|
||||||
|
fix-help check-help
|
||||||
|
] recover ;
|
||||||
|
|
||||||
|
: unlinked-words ( -- seq )
|
||||||
|
all-word-help [ parents empty? ] subset ;
|
||||||
|
|
||||||
|
: linked-undocumented-words ( -- seq )
|
||||||
|
all-words
|
||||||
|
[ word-help not ] subset
|
||||||
|
[ parents empty? not ] subset
|
||||||
|
[ "predicating" word-prop not ] subset ;
|
||||||
|
|
||||||
|
PROVIDE: apps/help-lint ;
|
||||||
|
|
||||||
|
MAIN: apps/help-lint check-help ;
|
||||||
|
|
@ -1,4 +1,5 @@
|
||||||
USING: io kernel math namespaces prettyprint sequences strings ;
|
USING: arrays io kernel math namespaces prettyprint sequences
|
||||||
|
strings ;
|
||||||
IN: hexdump-internals
|
IN: hexdump-internals
|
||||||
|
|
||||||
: header. ( len -- )
|
: header. ( len -- )
|
||||||
|
|
@ -8,7 +9,7 @@ IN: hexdump-internals
|
||||||
: h-pad. ( digit -- ) >hex 2 CHAR: 0 pad-left write ;
|
: h-pad. ( digit -- ) >hex 2 CHAR: 0 pad-left write ;
|
||||||
: line. ( str n -- )
|
: line. ( str n -- )
|
||||||
offset. [ [ h-pad. " " write ] each ] keep
|
offset. [ [ h-pad. " " write ] each ] keep
|
||||||
16 over length - [ " " write ] times
|
16 over length - " " <array> concat write
|
||||||
[ dup printable? [ drop CHAR: . ] unless ch>string write ] each
|
[ dup printable? [ drop CHAR: . ] unless ch>string write ] each
|
||||||
terpri ;
|
terpri ;
|
||||||
|
|
||||||
|
|
@ -1,3 +1,3 @@
|
||||||
PROVIDE: contrib/hexdump
|
PROVIDE: apps/hexdump
|
||||||
{ +files+ { "hexdump.factor" } }
|
{ +files+ { "hexdump.factor" } }
|
||||||
{ +tests+ { "test/hexdump.factor" } } ;
|
{ +tests+ { "test/hexdump.factor" } } ;
|
||||||
|
|
@ -1,12 +1,12 @@
|
||||||
! Eduardo Cavazos - wayo.cavazos@gmail.com
|
! Eduardo Cavazos - wayo.cavazos@gmail.com
|
||||||
|
|
||||||
REQUIRES: contrib/math
|
REQUIRES: libs/math
|
||||||
contrib/vars
|
libs/vars
|
||||||
contrib/slate
|
libs/slate
|
||||||
contrib/lindenmayer/opengl
|
apps/lindenmayer/opengl
|
||||||
contrib/lindenmayer/turtle
|
apps/lindenmayer/turtle
|
||||||
contrib/lindenmayer/camera
|
apps/lindenmayer/camera
|
||||||
contrib/lindenmayer/camera-slate ;
|
apps/lindenmayer/camera-slate ;
|
||||||
|
|
||||||
USING: kernel alien namespaces arrays vectors math opengl sequences threads
|
USING: kernel alien namespaces arrays vectors math opengl sequences threads
|
||||||
hashtables strings gadgets
|
hashtables strings gadgets
|
||||||
|
|
@ -294,7 +294,7 @@ reset-turtle
|
||||||
: init-slate ( -- )
|
: init-slate ( -- )
|
||||||
<camera-slate> >slate
|
<camera-slate> >slate
|
||||||
namespace slate> set-slate-ns
|
namespace slate> set-slate-ns
|
||||||
slate> "L-system" open-titled-window
|
slate> "L-system" open-window
|
||||||
[ display ] >action ;
|
[ display ] >action ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
@ -0,0 +1,2 @@
|
||||||
|
PROVIDE: apps/lindenmayer
|
||||||
|
{ +files+ { "lindenmayer.factor" } } ;
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
REQUIRES: contrib/alien ;
|
REQUIRES: libs/alien ;
|
||||||
USING: kernel sequences opengl alien-contrib ;
|
USING: kernel sequences opengl alien-contrib ;
|
||||||
IN: opengl-contrib
|
IN: opengl-contrib
|
||||||
|
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
REQUIRES: contrib/math contrib/vars ;
|
REQUIRES: libs/math libs/vars ;
|
||||||
USING: kernel math namespaces sequences arrays math-contrib vars ;
|
USING: kernel math namespaces sequences arrays math-contrib vars ;
|
||||||
IN: turtle
|
IN: turtle
|
||||||
|
|
||||||
|
|
@ -0,0 +1,15 @@
|
||||||
|
IN: lisppaste
|
||||||
|
REQUIRES: libs/xml-rpc ;
|
||||||
|
USING: arrays kernel xml-rpc ;
|
||||||
|
|
||||||
|
: url "http://www.common-lisp.net:8185/RPC2" ;
|
||||||
|
|
||||||
|
: channels ( -- seq )
|
||||||
|
{ } "listchannels" url invoke-method ;
|
||||||
|
|
||||||
|
: lisppaste ( seq -- response )
|
||||||
|
! seq is { channel user title contents }
|
||||||
|
! or { channel user title contents annotation-number }
|
||||||
|
"newpaste" url invoke-method ;
|
||||||
|
|
||||||
|
PROVIDE: apps/lisppaste ;
|
||||||
|
|
@ -1,8 +1,8 @@
|
||||||
PROVIDE: examples/mandel
|
PROVIDE: apps/mandel
|
||||||
{ +files+ { "mandel.factor" } }
|
{ +files+ { "mandel.factor" } }
|
||||||
{ +tests+ { "tests.factor" } } ;
|
{ +tests+ { "tests.factor" } } ;
|
||||||
|
|
||||||
USE: mandel
|
USE: mandel
|
||||||
USE: test
|
USE: test
|
||||||
|
|
||||||
MAIN: examples/mandel [ "mandel.pnm" run>file ] time ;
|
MAIN: apps/mandel [ "mandel.pnm" run>file ] time ;
|
||||||
|
|
@ -0,0 +1,9 @@
|
||||||
|
REQUIRES: libs/lazy-lists libs/shuffle ;
|
||||||
|
PROVIDE: apps/random-tester
|
||||||
|
{ +files+ {
|
||||||
|
"utils.factor"
|
||||||
|
"random.factor"
|
||||||
|
"random-tester.factor"
|
||||||
|
"random-tester2.factor"
|
||||||
|
"type.factor"
|
||||||
|
} } ;
|
||||||
|
|
@ -105,10 +105,6 @@ IN: random-tester
|
||||||
: 2-complex>complex { * + - /f } ;
|
: 2-complex>complex { * + - /f } ;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
SYMBOL: last-quot
|
SYMBOL: last-quot
|
||||||
SYMBOL: first-arg
|
SYMBOL: first-arg
|
||||||
SYMBOL: second-arg
|
SYMBOL: second-arg
|
||||||
|
|
@ -178,10 +174,10 @@ SYMBOL: second-arg
|
||||||
|
|
||||||
|
|
||||||
! RANDOM QUOTATIONS TO TEST
|
! RANDOM QUOTATIONS TO TEST
|
||||||
: random-1-integer>x-quot ( -- quot ) 1-integer>x nth-rand unit ;
|
: random-1-integer>x-quot ( -- quot ) 1-integer>x pick-one unit ;
|
||||||
: random-1-ratio>x-quot ( -- quot ) 1-ratio>x nth-rand unit ;
|
: random-1-ratio>x-quot ( -- quot ) 1-ratio>x pick-one unit ;
|
||||||
: random-1-float>x-quot ( -- quot ) 1-float>x nth-rand unit ;
|
: random-1-float>x-quot ( -- quot ) 1-float>x pick-one unit ;
|
||||||
: random-1-complex>x-quot ( -- quot ) 1-complex>x nth-rand unit ;
|
: random-1-complex>x-quot ( -- quot ) 1-complex>x pick-one unit ;
|
||||||
|
|
||||||
: test-1-integer>x ( -- )
|
: test-1-integer>x ( -- )
|
||||||
random-integer random-1-integer>x-quot 1-interpreted-vs-compiled-check ;
|
random-integer random-1-integer>x-quot 1-interpreted-vs-compiled-check ;
|
||||||
|
|
@ -193,18 +189,18 @@ SYMBOL: second-arg
|
||||||
random-complex random-1-complex>x-quot 1-interpreted-vs-compiled-check ;
|
random-complex random-1-complex>x-quot 1-interpreted-vs-compiled-check ;
|
||||||
|
|
||||||
|
|
||||||
: random-1-float>float-quot ( -- obj ) 1-float>float nth-rand unit ;
|
: random-1-float>float-quot ( -- obj ) 1-float>float pick-one unit ;
|
||||||
: random-2-float>float-quot ( -- obj ) 2-float>float nth-rand unit ;
|
: random-2-float>float-quot ( -- obj ) 2-float>float pick-one unit ;
|
||||||
: nrandom-2-float>float-quot ( -- obj )
|
: nrandom-2-float>float-quot ( -- obj )
|
||||||
[
|
[
|
||||||
5
|
5
|
||||||
[
|
[
|
||||||
{
|
{
|
||||||
[ 2-float>float nth-rand , random-float , ]
|
[ 2-float>float pick-one , random-float , ]
|
||||||
[ 1-float>float nth-rand , ]
|
[ 1-float>float pick-one , ]
|
||||||
} do-one
|
} do-one
|
||||||
] times
|
] times
|
||||||
2-float>float nth-rand ,
|
2-float>float pick-one ,
|
||||||
] [ ] make ;
|
] [ ] make ;
|
||||||
|
|
||||||
: test-1-float>float ( -- )
|
: test-1-float>float ( -- )
|
||||||
|
|
@ -220,8 +216,8 @@ SYMBOL: second-arg
|
||||||
: test-1-integer>x-runtime ( -- )
|
: test-1-integer>x-runtime ( -- )
|
||||||
random-integer random-1-integer>x-quot 1-runtime-check ;
|
random-integer random-1-integer>x-quot 1-runtime-check ;
|
||||||
|
|
||||||
: random-1-integer>x-throws-quot ( -- obj ) 1-integer>x-throws nth-rand unit ;
|
: random-1-integer>x-throws-quot ( -- obj ) 1-integer>x-throws pick-one unit ;
|
||||||
: random-1-ratio>x-throws-quot ( -- obj ) 1-ratio>x-throws nth-rand unit ;
|
: random-1-ratio>x-throws-quot ( -- obj ) 1-ratio>x-throws pick-one unit ;
|
||||||
: test-1-integer>x-throws ( -- obj )
|
: test-1-integer>x-throws ( -- obj )
|
||||||
random-integer random-1-integer>x-throws-quot
|
random-integer random-1-integer>x-throws-quot
|
||||||
1-interpreted-vs-compiled-check-catch ;
|
1-interpreted-vs-compiled-check-catch ;
|
||||||
|
|
@ -234,16 +230,9 @@ SYMBOL: second-arg
|
||||||
: test-2-integer>x-throws ( -- )
|
: test-2-integer>x-throws ( -- )
|
||||||
[
|
[
|
||||||
random-integer , random-integer ,
|
random-integer , random-integer ,
|
||||||
2-x>y-throws nth-rand ,
|
2-x>y-throws pick-one ,
|
||||||
] [ ] make 2-interpreted-vs-compiled-check-catch ;
|
] [ ] make 2-interpreted-vs-compiled-check-catch ;
|
||||||
|
|
||||||
! : test-^-shift ( -- )
|
|
||||||
! [
|
|
||||||
! 100 random-int 50 - ,
|
|
||||||
! 100 random-int 50 - ,
|
|
||||||
! { ^ shift } nth-rand ,
|
|
||||||
! ] [ ] make 2-interpreted-vs-compiled-check-catch ;
|
|
||||||
|
|
||||||
! : test-^-ratio ( -- )
|
! : test-^-ratio ( -- )
|
||||||
! [
|
! [
|
||||||
! random-ratio , random-ratio , \ ^ ,
|
! random-ratio , random-ratio , \ ^ ,
|
||||||
|
|
@ -251,27 +240,27 @@ SYMBOL: second-arg
|
||||||
|
|
||||||
: test-0-float?-when
|
: test-0-float?-when
|
||||||
[
|
[
|
||||||
random-number , \ dup , \ float? , 1-float>x nth-rand unit , \ when ,
|
random-number , \ dup , \ float? , 1-float>x pick-one unit , \ when ,
|
||||||
] [ ] make 0-runtime-check ;
|
] [ ] make 0-runtime-check ;
|
||||||
|
|
||||||
: test-1-integer?-when
|
: test-1-integer?-when
|
||||||
random-integer [
|
random-integer [
|
||||||
\ dup , \ integer? , 1-integer>x nth-rand unit , \ when ,
|
\ dup , \ integer? , 1-integer>x pick-one unit , \ when ,
|
||||||
] [ ] make 1-interpreted-vs-compiled-check ;
|
] [ ] make 1-interpreted-vs-compiled-check ;
|
||||||
|
|
||||||
: test-1-ratio?-when
|
: test-1-ratio?-when
|
||||||
random-ratio [
|
random-ratio [
|
||||||
\ dup , \ ratio? , 1-ratio>x nth-rand unit , \ when ,
|
\ dup , \ ratio? , 1-ratio>x pick-one unit , \ when ,
|
||||||
] [ ] make 1-interpreted-vs-compiled-check ;
|
] [ ] make 1-interpreted-vs-compiled-check ;
|
||||||
|
|
||||||
: test-1-float?-when
|
: test-1-float?-when
|
||||||
random-float [
|
random-float [
|
||||||
\ dup , \ float? , 1-float>x nth-rand unit , \ when ,
|
\ dup , \ float? , 1-float>x pick-one unit , \ when ,
|
||||||
] [ ] make 1-interpreted-vs-compiled-check ;
|
] [ ] make 1-interpreted-vs-compiled-check ;
|
||||||
|
|
||||||
: test-1-complex?-when
|
: test-1-complex?-when
|
||||||
random-complex [
|
random-complex [
|
||||||
\ dup , \ complex? , 1-complex>x nth-rand unit , \ when ,
|
\ dup , \ complex? , 1-complex>x pick-one unit , \ when ,
|
||||||
] [ ] make 1-interpreted-vs-compiled-check ;
|
] [ ] make 1-interpreted-vs-compiled-check ;
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -308,5 +297,5 @@ SYMBOL: second-arg
|
||||||
test-1-complex?-when
|
test-1-complex?-when
|
||||||
! full-gc
|
! full-gc
|
||||||
! code-gc
|
! code-gc
|
||||||
} nth-rand dup . execute terpri ;
|
} pick-one dup . execute terpri ;
|
||||||
|
|
||||||
|
|
@ -0,0 +1,163 @@
|
||||||
|
USING: compiler errors inference interpreter io
|
||||||
|
kernel math memory namespaces prettyprint random-tester
|
||||||
|
sequences tools words ;
|
||||||
|
USING: arrays definitions generic graphs hashtables ;
|
||||||
|
IN: random-tester2
|
||||||
|
|
||||||
|
SYMBOL: wordbank
|
||||||
|
: w1
|
||||||
|
{
|
||||||
|
die
|
||||||
|
set-walker-hook exit
|
||||||
|
|
||||||
|
xref-words
|
||||||
|
|
||||||
|
times repeat (repeat)
|
||||||
|
supremum infimum assoc rassoc norm-sq
|
||||||
|
product sum curry remove-all member? subseq?
|
||||||
|
|
||||||
|
(next-power-of-2) (^) d>w/w w>h/h millis
|
||||||
|
(random-int) ^n integer, first-bignum
|
||||||
|
most-positive-fixnum ^ init-random next-power-of-2
|
||||||
|
most-negative-fixnum
|
||||||
|
|
||||||
|
clear-hash build-graph
|
||||||
|
|
||||||
|
>r r>
|
||||||
|
|
||||||
|
set-callstack set-word set-word-prop
|
||||||
|
set-catchstack set-namestack set-retainstack
|
||||||
|
set-continuation-retain continuation-catch
|
||||||
|
set-continuation-name catchstack retainstack
|
||||||
|
set-no-math-method-generic
|
||||||
|
set-no-math-method-right
|
||||||
|
set-check-method-class
|
||||||
|
set-check-create-name
|
||||||
|
set-nested-style-stream-style
|
||||||
|
set-pathname-string
|
||||||
|
set-check-create-vocab
|
||||||
|
<check-create> check-create?
|
||||||
|
reset-generic forget-class
|
||||||
|
create forget-word forget-vocab forget forget-tuple
|
||||||
|
remove-word-prop empty-method
|
||||||
|
continue-with <continuation>
|
||||||
|
|
||||||
|
define-compound define make-generic
|
||||||
|
define-method define-predicate-class
|
||||||
|
define-tuple define-temp define-tuple-slots
|
||||||
|
define-writer define-predicate define-generic
|
||||||
|
?make-generic define-reader define-slot define-slots
|
||||||
|
define-typecheck define-slot-word define-union
|
||||||
|
define-generic* with-methods define-constructor
|
||||||
|
predicate-word condition-continuation define-symbol
|
||||||
|
|
||||||
|
ndrop
|
||||||
|
|
||||||
|
set-word-def set-word-name
|
||||||
|
set-word-props set-word-primitive
|
||||||
|
|
||||||
|
stdio
|
||||||
|
close readln (readln) read1 read with-server
|
||||||
|
stream-read stream-readln stream-read1 lines (lines)
|
||||||
|
contents stream-copy stream-flush
|
||||||
|
stream-format set-line-reader-cr
|
||||||
|
|
||||||
|
double>bits float>bits >bignum
|
||||||
|
|
||||||
|
intern-slots class-predicates delete (delete) prune memq?
|
||||||
|
normalize norm vneg vmax vmin v- v+ [v-]
|
||||||
|
|
||||||
|
bin> oct> le> be> hex> string>number
|
||||||
|
|
||||||
|
gensym random-int counter <byte-array>
|
||||||
|
<word> <client-stream> <server> <client>
|
||||||
|
<duplex-stream> <file-writer> <file-reader> ! <file-r/w>
|
||||||
|
init-namespaces unxref-word set-global set off on
|
||||||
|
nest
|
||||||
|
set-restart-obj
|
||||||
|
+@ inc dec
|
||||||
|
|
||||||
|
changed-words
|
||||||
|
callstack namespace namestack global vocabularies
|
||||||
|
|
||||||
|
path+ parent-dir
|
||||||
|
|
||||||
|
.s . word-xt.
|
||||||
|
|
||||||
|
<continuation> continue-with
|
||||||
|
set-delegate
|
||||||
|
|
||||||
|
closure
|
||||||
|
|
||||||
|
tabular-output simple-slots
|
||||||
|
|
||||||
|
join concat (group)
|
||||||
|
}
|
||||||
|
{ "arrays" "errors" "generic" "graphs" "hashtables" "io"
|
||||||
|
"kernel" "math" "namespaces"
|
||||||
|
"queues" "strings" "sequences" "vectors" "words" }
|
||||||
|
[ words ] map concat diff ;
|
||||||
|
|
||||||
|
w1 wordbank set-global
|
||||||
|
|
||||||
|
: databank
|
||||||
|
{
|
||||||
|
! V{ } H{ } V{ 3 } { 3 } { } "" "asdf"
|
||||||
|
pi 1/0. -1/0. 0/0. [ ]
|
||||||
|
f t "" 0 0.0 3.14 2 -3 -7 20 3/4 -3/4 1.2/3 3.5
|
||||||
|
C{ 2 2 } C{ 1/0. 1/0. }
|
||||||
|
} ;
|
||||||
|
|
||||||
|
: setup-test ( #data #code -- data... quot )
|
||||||
|
#! variable stack effect
|
||||||
|
>r [ databank pick-one ] times r>
|
||||||
|
[ drop wordbank get pick-one ] map >quotation ;
|
||||||
|
|
||||||
|
SYMBOL: before
|
||||||
|
SYMBOL: after
|
||||||
|
SYMBOL: quot
|
||||||
|
SYMBOL: err
|
||||||
|
err off
|
||||||
|
|
||||||
|
: test-compiler ( data... quot -- ... )
|
||||||
|
err off
|
||||||
|
dup quot set
|
||||||
|
datastack clone dup pop* before set
|
||||||
|
[ call ] catch drop datastack clone after set
|
||||||
|
clear
|
||||||
|
before get [ ] each
|
||||||
|
quot get [ compile-1 ] [ err on ] recover ;
|
||||||
|
|
||||||
|
: do-test ( data... quot -- )
|
||||||
|
.s flush test-compiler
|
||||||
|
err get [
|
||||||
|
datastack after get 2dup = [
|
||||||
|
2drop
|
||||||
|
] [
|
||||||
|
[ . ] each
|
||||||
|
"--" print
|
||||||
|
[ . ] each quot get .
|
||||||
|
"not =" throw
|
||||||
|
] if
|
||||||
|
] unless
|
||||||
|
clear ;
|
||||||
|
|
||||||
|
: random-test ( #data #code -- )
|
||||||
|
setup-test do-test ;
|
||||||
|
|
||||||
|
: run-random-tester2
|
||||||
|
100000000000000 [ 6 3 random-test ] times ;
|
||||||
|
|
||||||
|
|
||||||
|
! A worthwhile test that has not been run extensively
|
||||||
|
1000 [ drop gensym ] map "syms" set
|
||||||
|
|
||||||
|
: pick-one [ length random-int ] keep nth ;
|
||||||
|
|
||||||
|
: fooify-test
|
||||||
|
"syms" get pick-one
|
||||||
|
2000 random-int >quotation
|
||||||
|
over set-word-def
|
||||||
|
100 random-int zero? [ code-gc ] when
|
||||||
|
compile fooify-test ;
|
||||||
|
|
||||||
|
|
@ -22,7 +22,7 @@ IN: random-tester
|
||||||
random-int 2 swap ^ random-int ;
|
random-int 2 swap ^ random-int ;
|
||||||
|
|
||||||
: random-seq ( -- seq )
|
: random-seq ( -- seq )
|
||||||
{ [ ] { } V{ } "" } nth-rand
|
{ [ ] { } V{ } "" } pick-one
|
||||||
[ max-length random-int [ max-value random-int , ] times ] swap make ;
|
[ max-length random-int [ max-value random-int , ] times ] swap make ;
|
||||||
|
|
||||||
: random-string
|
: random-string
|
||||||
|
|
@ -56,7 +56,7 @@ SYMBOL: special-complexes
|
||||||
coin-flip [
|
coin-flip [
|
||||||
random-fixnum
|
random-fixnum
|
||||||
] [
|
] [
|
||||||
coin-flip [ random-bignum ] [ special-integers nth-rand ] if
|
coin-flip [ random-bignum ] [ special-integers pick-one ] if
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: random-positive-integer ( -- int )
|
: random-positive-integer ( -- int )
|
||||||
|
|
@ -70,7 +70,7 @@ SYMBOL: special-complexes
|
||||||
1000000000 dup [ random-int ] 2apply 1+ / coin-flip [ neg ] when dup [ drop random-ratio ] unless 10% [ drop 0 ] when ;
|
1000000000 dup [ random-int ] 2apply 1+ / coin-flip [ neg ] when dup [ drop random-ratio ] unless 10% [ drop 0 ] when ;
|
||||||
|
|
||||||
: random-float ( -- float )
|
: random-float ( -- float )
|
||||||
coin-flip [ random-ratio ] [ special-floats nth-rand ] if
|
coin-flip [ random-ratio ] [ special-floats pick-one ] if
|
||||||
coin-flip
|
coin-flip
|
||||||
[ .0000000000000000001 /f ] [ coin-flip [ .00000000000000001 * ] when ] if
|
[ .0000000000000000001 /f ] [ coin-flip [ .00000000000000001 * ] when ] if
|
||||||
>float ;
|
>float ;
|
||||||
|
|
@ -0,0 +1,88 @@
|
||||||
|
USING: errors generic io kernel lazy-lists math memory namespaces
|
||||||
|
prettyprint random-tester2 sequences tools words ;
|
||||||
|
IN: random-tester
|
||||||
|
|
||||||
|
: inert ;
|
||||||
|
TUPLE: inert-object ;
|
||||||
|
|
||||||
|
: inputs ( -- seq )
|
||||||
|
{
|
||||||
|
0 -1 -1000000000000000000000000
|
||||||
|
! -268435457
|
||||||
|
inert
|
||||||
|
! T{ inert-object f }
|
||||||
|
-29/2 1000000000000000000000000000000/1111111111111111111111111111111111111111111
|
||||||
|
3/4
|
||||||
|
-1000000000000000000000000/111111111111111111
|
||||||
|
-3.14 1/0. 0.0 -1/0. 3.14 0/0.
|
||||||
|
C{ 1 -1 }
|
||||||
|
W{ 55 }
|
||||||
|
{ }
|
||||||
|
f t
|
||||||
|
H{ }
|
||||||
|
V{ 1 0 65536 }
|
||||||
|
""
|
||||||
|
SBUF" "
|
||||||
|
[ ]
|
||||||
|
! DLL" libm.dylib"
|
||||||
|
! ALIEN: 1
|
||||||
|
T{ inert-object f }
|
||||||
|
} ;
|
||||||
|
|
||||||
|
: word-inputs ( word -- seq )
|
||||||
|
[ stack-effect effect-in length ] [ drop 0 ] recover
|
||||||
|
inputs swap ;
|
||||||
|
|
||||||
|
: type-error? ( exception -- ? )
|
||||||
|
[ swap execute or ] curry
|
||||||
|
>r { no-method? no-math-method? } f r> reduce ;
|
||||||
|
|
||||||
|
: maybe-explode
|
||||||
|
dup sequence? [ [ ] each ] when ; inline
|
||||||
|
|
||||||
|
TUPLE: success quot inputs outputs ;
|
||||||
|
|
||||||
|
SYMBOL: err
|
||||||
|
SYMBOL: type-error
|
||||||
|
SYMBOL: params
|
||||||
|
SYMBOL: last-time
|
||||||
|
SYMBOL: quot
|
||||||
|
: throws? ( data... quot -- ? )
|
||||||
|
dup quot set
|
||||||
|
err off type-error off
|
||||||
|
>r
|
||||||
|
dup clone params set
|
||||||
|
maybe-explode
|
||||||
|
r>
|
||||||
|
! .s flush
|
||||||
|
dup last-time get = [ dup . flush dup last-time set ] unless
|
||||||
|
[ call ] [ err on ] recover
|
||||||
|
err get [
|
||||||
|
dup type-error? dup [
|
||||||
|
! .s
|
||||||
|
] unless
|
||||||
|
type-error set
|
||||||
|
] [
|
||||||
|
datastack clone >r quot get params get r> <success>
|
||||||
|
,
|
||||||
|
] if clear type-error get ;
|
||||||
|
|
||||||
|
: test-inputs ( word -- seq )
|
||||||
|
[
|
||||||
|
[ word-inputs ] keep
|
||||||
|
unit [
|
||||||
|
throws? not clear
|
||||||
|
] curry each-permutation
|
||||||
|
] { } make ;
|
||||||
|
|
||||||
|
: (test1)
|
||||||
|
[
|
||||||
|
[ stack-effect effect-in length ] catch [ 4 < ] unless
|
||||||
|
! ] subset [ [ [ test-inputs , full-gc ] { } make , ] each ] { } make ;
|
||||||
|
! ] subset [ [ [ test-inputs , ] { } make , ] each ] { } make ;
|
||||||
|
] subset [ test-inputs clear ] each ;
|
||||||
|
|
||||||
|
: test1
|
||||||
|
wordbank get (test1) ;
|
||||||
|
|
||||||
|
! full-gc finds corrupted memory faster
|
||||||
|
|
@ -0,0 +1,73 @@
|
||||||
|
USING: kernel math sequences namespaces errors hashtables words
|
||||||
|
arrays parser compiler syntax io optimizer inference shuffle
|
||||||
|
tools prettyprint ;
|
||||||
|
IN: random-tester
|
||||||
|
|
||||||
|
: pick-one ( seq -- elt )
|
||||||
|
[ length random-int ] keep nth ;
|
||||||
|
|
||||||
|
! HASHTABLES
|
||||||
|
: random-hash-entry ( hash -- key value )
|
||||||
|
hash>alist pick-one first2 ;
|
||||||
|
|
||||||
|
: coin-flip ( -- bool ) 2 random-int zero? ;
|
||||||
|
: do-one ( seq -- ) pick-one call ; inline
|
||||||
|
|
||||||
|
: nzero-array ( seq -- )
|
||||||
|
dup length >r 0 r> [ pick set-nth ] each-with drop ;
|
||||||
|
|
||||||
|
: zero-array
|
||||||
|
[ drop 0 ] map ;
|
||||||
|
|
||||||
|
TUPLE: p-list seq max count count-vec ;
|
||||||
|
: make-p-list ( seq n -- tuple )
|
||||||
|
>r dup length [ 1- ] keep r>
|
||||||
|
[ ^ 0 swap 2array ] keep
|
||||||
|
zero-array <p-list> ;
|
||||||
|
|
||||||
|
: inc-seq ( seq max -- )
|
||||||
|
2dup [ < ] curry find-last over -1 = [
|
||||||
|
3drop nzero-array
|
||||||
|
] [
|
||||||
|
nipd 1+ 2over swap set-nth
|
||||||
|
1+ over length rot <slice> nzero-array
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
: inc-count ( tuple -- )
|
||||||
|
[ p-list-count first2 >r 1+ r> 2array ] keep
|
||||||
|
set-p-list-count ;
|
||||||
|
|
||||||
|
: get-permutation ( tuple -- seq )
|
||||||
|
[ p-list-seq ] keep p-list-count-vec [ swap nth ] map-with ;
|
||||||
|
|
||||||
|
: p-list-next ( tuple -- seq/f )
|
||||||
|
dup p-list-count first2 < [
|
||||||
|
[
|
||||||
|
[ get-permutation ] keep
|
||||||
|
[ p-list-count-vec ] keep p-list-max
|
||||||
|
inc-seq
|
||||||
|
] keep inc-count
|
||||||
|
] [
|
||||||
|
drop f
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
: (permutations) ( tuple -- )
|
||||||
|
dup p-list-next [ , (permutations) ] [ drop ] if* ;
|
||||||
|
|
||||||
|
: permutations ( seq n -- seq )
|
||||||
|
make-p-list
|
||||||
|
[
|
||||||
|
(permutations)
|
||||||
|
] { } make ;
|
||||||
|
|
||||||
|
: (each-permutation) ( tuple quot -- )
|
||||||
|
over p-list-next [
|
||||||
|
[ rot drop swap call ] 3keep
|
||||||
|
drop (each-permutation)
|
||||||
|
] [
|
||||||
|
2drop
|
||||||
|
] if* ; inline
|
||||||
|
|
||||||
|
: each-permutation ( seq n quot -- )
|
||||||
|
>r make-p-list r> (each-permutation) ;
|
||||||
|
|
||||||
|
|
@ -161,6 +161,6 @@ DEFER: create ( level c r -- scene )
|
||||||
"Generating " write dup write "..." print
|
"Generating " write dup write "..." print
|
||||||
<file-writer> [ run write ] with-stream ;
|
<file-writer> [ run write ] with-stream ;
|
||||||
|
|
||||||
PROVIDE: examples/raytracer ;
|
PROVIDE: apps/raytracer ;
|
||||||
|
|
||||||
MAIN: examples/raytracer [ "raytracer.pnm" run>file ] time ;
|
MAIN: apps/raytracer [ "raytracer.pnm" run>file ] time ;
|
||||||
|
|
@ -0,0 +1,45 @@
|
||||||
|
<?xml version="1.0" encoding="utf-8"?>
|
||||||
|
<feed xmlns="http://www.w3.org/2005/Atom">
|
||||||
|
<title type="text">dive into mark</title>
|
||||||
|
<subtitle type="html">
|
||||||
|
A <em>lot</em> of effort
|
||||||
|
went into making this effortless
|
||||||
|
</subtitle>
|
||||||
|
<updated>2005-07-31T12:29:29Z</updated>
|
||||||
|
<id>tag:example.org,2003:3</id>
|
||||||
|
<link rel="alternate" type="text/html"
|
||||||
|
hreflang="en" href="http://example.org/"/>
|
||||||
|
<link rel="self" type="application/atom+xml"
|
||||||
|
href="http://example.org/feed.atom"/>
|
||||||
|
<rights>Copyright (c) 2003, Mark Pilgrim</rights>
|
||||||
|
<generator uri="http://www.example.com/" version="1.0">
|
||||||
|
Example Toolkit
|
||||||
|
</generator>
|
||||||
|
<entry>
|
||||||
|
<title>Atom draft-07 snapshot</title>
|
||||||
|
<link rel="alternate" type="text/html"
|
||||||
|
href="http://example.org/2005/04/02/atom"/>
|
||||||
|
<link rel="enclosure" type="audio/mpeg" length="1337"
|
||||||
|
href="http://example.org/audio/ph34r_my_podcast.mp3"/>
|
||||||
|
<id>tag:example.org,2003:3.2397</id>
|
||||||
|
<updated>2005-07-31T12:29:29Z</updated>
|
||||||
|
<published>2003-12-13T08:29:29-04:00</published>
|
||||||
|
<author>
|
||||||
|
<name>Mark Pilgrim</name>
|
||||||
|
<uri>http://example.org/</uri>
|
||||||
|
<email>f8dy@example.com</email>
|
||||||
|
</author>
|
||||||
|
<contributor>
|
||||||
|
<name>Sam Ruby</name>
|
||||||
|
</contributor>
|
||||||
|
<contributor>
|
||||||
|
<name>Joe Gregorio</name>
|
||||||
|
</contributor>
|
||||||
|
<content type="xhtml" xml:lang="en"
|
||||||
|
xml:base="http://diveintomark.org/">
|
||||||
|
<div xmlns="http://www.w3.org/1999/xhtml">
|
||||||
|
<p><i>[Update: The Atom draft is finished.]</i></p>
|
||||||
|
</div>
|
||||||
|
</content>
|
||||||
|
</entry>
|
||||||
|
</feed>
|
||||||
|
|
@ -0,0 +1,10 @@
|
||||||
|
REQUIRES: libs/http-client libs/httpd libs/sqlite libs/xml
|
||||||
|
libs/parser-combinators ;
|
||||||
|
PROVIDE: apps/rss
|
||||||
|
{ +files+ {
|
||||||
|
"rss.factor"
|
||||||
|
"rss-reader.factor"
|
||||||
|
} }
|
||||||
|
{ +tests+ {
|
||||||
|
"test.factor"
|
||||||
|
} } ;
|
||||||
|
|
@ -72,20 +72,20 @@ SYMBOL: db
|
||||||
] show 2drop ;
|
] show 2drop ;
|
||||||
|
|
||||||
: rss>reader-feed ( url rss -- reader-feed )
|
: rss>reader-feed ( url rss -- reader-feed )
|
||||||
[ rss-title ] keep rss-link <reader-feed> ;
|
[ feed-title ] keep feed-link <reader-feed> ;
|
||||||
|
|
||||||
: rss-entry>reader-entry ( url entry -- reader-entry )
|
: rss-entry>reader-entry ( url entry -- reader-entry )
|
||||||
[ rss-entry-link ] keep
|
[ entry-link ] keep
|
||||||
[ rss-entry-title ] keep
|
[ entry-title ] keep
|
||||||
[ rss-entry-description ] keep
|
[ entry-description ] keep
|
||||||
rss-entry-pub-date
|
entry-pub-date
|
||||||
<reader-entry> ;
|
<reader-entry> ;
|
||||||
|
|
||||||
: update-feed-database ( url -- )
|
: update-feed-database ( url -- )
|
||||||
dup remove-feed
|
dup remove-feed
|
||||||
dup rss-get
|
dup news-get
|
||||||
2dup rss>reader-feed db get swap save-tuple
|
2dup rss>reader-feed db get swap save-tuple
|
||||||
rss-entries [
|
feed-entries [
|
||||||
dupd rss-entry>reader-entry
|
dupd rss-entry>reader-entry
|
||||||
dup >r reader-entry-link f f f <reader-entry> db get swap find-tuples [ db get swap delete-tuple ] each r>
|
dup >r reader-entry-link f f f <reader-entry> db get swap find-tuples [ db get swap delete-tuple ] each r>
|
||||||
db get swap save-tuple
|
db get swap save-tuple
|
||||||
|
|
@ -0,0 +1,89 @@
|
||||||
|
! Copyright (C) 2006 Chris Double.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
IN: rss
|
||||||
|
USING: kernel http-client xml xml-utils xml-data errors io strings
|
||||||
|
sequences xml-writer parser-combinators lazy-lists ;
|
||||||
|
|
||||||
|
: ?children>string ( tag/f -- string/f )
|
||||||
|
[ children>string ] [ f ] if* ;
|
||||||
|
|
||||||
|
LAZY: '&' ( -- parser )
|
||||||
|
"&" token
|
||||||
|
[ blank? ] satisfy &>
|
||||||
|
[ "&" swap add ] <@ ;
|
||||||
|
|
||||||
|
: &>& ( string -- string )
|
||||||
|
'&' replace ;
|
||||||
|
|
||||||
|
TUPLE: feed title link entries ;
|
||||||
|
TUPLE: entry title link description pub-date ;
|
||||||
|
|
||||||
|
: rss1.0 ( xml -- feed )
|
||||||
|
[
|
||||||
|
"channel" find-tag
|
||||||
|
[ "title" find-tag children>string ] keep
|
||||||
|
"link" find-tag children>string
|
||||||
|
] keep
|
||||||
|
"item" find-tags [
|
||||||
|
[ "title" find-tag children>string ] keep
|
||||||
|
[ "link" find-tag children>string ] keep
|
||||||
|
[ "description" find-tag children>string ] keep
|
||||||
|
f "date" "http://purl.org/dc/elements/1.1/" <name>
|
||||||
|
find-name-tag ?children>string
|
||||||
|
<entry>
|
||||||
|
] map <feed> ;
|
||||||
|
|
||||||
|
: rss2.0 ( xml -- feed )
|
||||||
|
"channel" find-tag
|
||||||
|
[ "title" find-tag children>string ] keep
|
||||||
|
[ "link" find-tag children>string ] keep
|
||||||
|
"item" find-tags [
|
||||||
|
[ "title" find-tag children>string ] keep
|
||||||
|
[ "link" find-tag ] keep
|
||||||
|
[ "guid" find-tag dupd ? children>string ] keep
|
||||||
|
[ "description" find-tag children>string ] keep
|
||||||
|
"pubDate" find-tag children>string <entry>
|
||||||
|
] map <feed> ;
|
||||||
|
|
||||||
|
: atom1.0 ( xml -- feed )
|
||||||
|
[ "title" find-tag children>string ] keep
|
||||||
|
[ "link" find-tag "href" prop-name-tag first ] keep
|
||||||
|
"entry" find-tags [
|
||||||
|
[ "title" find-tag children>string ] keep
|
||||||
|
[ "link" find-tag "href" prop-name-tag first ] keep
|
||||||
|
[
|
||||||
|
dup "content" find-tag
|
||||||
|
[ nip ] [ "summary" find-tag ] if*
|
||||||
|
dup tag-children [ tag? ] contains?
|
||||||
|
[ tag-children [ write-chunk ] string-out ]
|
||||||
|
[ children>string ] if
|
||||||
|
] keep
|
||||||
|
dup "published" find-tag
|
||||||
|
[ nip ] [ "updated" find-tag ] if*
|
||||||
|
children>string <entry>
|
||||||
|
] map <feed> ;
|
||||||
|
|
||||||
|
: feed ( xml -- feed )
|
||||||
|
dup name-tag {
|
||||||
|
{ [ dup "RDF" = ] [ drop rss1.0 ] }
|
||||||
|
{ [ dup "rss" = ] [ drop rss2.0 ] }
|
||||||
|
{ [ "feed" = ] [ atom1.0 ] }
|
||||||
|
{ [ t ] [ "Invalid newsfeed" throw ] }
|
||||||
|
} cond ;
|
||||||
|
|
||||||
|
: read-feed ( string -- feed )
|
||||||
|
! &>& ! this will be uncommented when parser-combinators are fixed
|
||||||
|
string>xml feed ;
|
||||||
|
|
||||||
|
: load-news-file ( filename -- feed )
|
||||||
|
#! Load an news syndication file and process it, returning
|
||||||
|
#! it as an feed tuple.
|
||||||
|
<file-reader> [ contents read-feed ] keep stream-close ;
|
||||||
|
|
||||||
|
: news-get ( url -- feed )
|
||||||
|
#! Retrieve an news syndication file, return as a feed tuple.
|
||||||
|
http-get rot 200 = [
|
||||||
|
nip read-feed
|
||||||
|
] [
|
||||||
|
2drop "Error retrieving newsfeed file" throw
|
||||||
|
] if ;
|
||||||
|
|
@ -0,0 +1,67 @@
|
||||||
|
<?xml version="1.0" encoding="utf-8"?>
|
||||||
|
|
||||||
|
<rdf:RDF
|
||||||
|
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
|
||||||
|
xmlns:dc="http://purl.org/dc/elements/1.1/"
|
||||||
|
xmlns:sy="http://purl.org/rss/1.0/modules/syndication/"
|
||||||
|
xmlns:co="http://purl.org/rss/1.0/modules/company/"
|
||||||
|
xmlns:ti="http://purl.org/rss/1.0/modules/textinput/"
|
||||||
|
xmlns="http://purl.org/rss/1.0/"
|
||||||
|
>
|
||||||
|
|
||||||
|
<channel rdf:about="http://meerkat.oreillynet.com/?_fl=rss1.0">
|
||||||
|
<title>Meerkat</title>
|
||||||
|
<link>http://meerkat.oreillynet.com</link>
|
||||||
|
<description>Meerkat: An Open Wire Service</description>
|
||||||
|
<dc:publisher>The O'Reilly Network</dc:publisher>
|
||||||
|
<dc:creator>Rael Dornfest (mailto:rael@oreilly.com)</dc:creator>
|
||||||
|
<dc:rights>Copyright © 2000 O'Reilly & Associates, Inc.</dc:rights>
|
||||||
|
<dc:date>2000-01-01T12:00+00:00</dc:date>
|
||||||
|
<sy:updatePeriod>hourly</sy:updatePeriod>
|
||||||
|
<sy:updateFrequency>2</sy:updateFrequency>
|
||||||
|
<sy:updateBase>2000-01-01T12:00+00:00</sy:updateBase>
|
||||||
|
|
||||||
|
<image rdf:resource="http://meerkat.oreillynet.com/icons/meerkat-powered.jpg" />
|
||||||
|
|
||||||
|
<items>
|
||||||
|
<rdf:Seq>
|
||||||
|
<rdf:li resource="http://c.moreover.com/click/here.pl?r123" />
|
||||||
|
</rdf:Seq>
|
||||||
|
</items>
|
||||||
|
|
||||||
|
<textinput rdf:resource="http://meerkat.oreillynet.com" />
|
||||||
|
|
||||||
|
</channel>
|
||||||
|
|
||||||
|
<image rdf:about="http://meerkat.oreillynet.com/icons/meerkat-powered.jpg">
|
||||||
|
<title>Meerkat Powered!</title>
|
||||||
|
<url>http://meerkat.oreillynet.com/icons/meerkat-powered.jpg</url>
|
||||||
|
<link>http://meerkat.oreillynet.com</link>
|
||||||
|
</image>
|
||||||
|
|
||||||
|
<item rdf:about="http://c.moreover.com/click/here.pl?r123">
|
||||||
|
<title>XML: A Disruptive Technology</title>
|
||||||
|
<link>http://c.moreover.com/click/here.pl?r123</link>
|
||||||
|
<dc:description>
|
||||||
|
XML is placing increasingly heavy loads on the existing technical
|
||||||
|
infrastructure of the Internet.
|
||||||
|
</dc:description>
|
||||||
|
<dc:publisher>The O'Reilly Network</dc:publisher>
|
||||||
|
<dc:creator>Simon St.Laurent (mailto:simonstl@simonstl.com)</dc:creator>
|
||||||
|
<dc:rights>Copyright © 2000 O'Reilly & Associates, Inc.</dc:rights>
|
||||||
|
<dc:subject>XML</dc:subject>
|
||||||
|
<co:name>XML.com</co:name>
|
||||||
|
<co:market>NASDAQ</co:market>
|
||||||
|
<co:symbol>XML</co:symbol>
|
||||||
|
</item>
|
||||||
|
|
||||||
|
<textinput rdf:about="http://meerkat.oreillynet.com">
|
||||||
|
<title>Search Meerkat</title>
|
||||||
|
<description>Search Meerkat's RSS Database...</description>
|
||||||
|
<name>s</name>
|
||||||
|
<link>http://meerkat.oreillynet.com/</link>
|
||||||
|
<ti:function>search</ti:function>
|
||||||
|
<ti:inputType>regex</ti:inputType>
|
||||||
|
</textinput>
|
||||||
|
|
||||||
|
</rdf:RDF>
|
||||||
|
|
@ -0,0 +1,37 @@
|
||||||
|
USING: rss io test ;
|
||||||
|
IN: temporary
|
||||||
|
|
||||||
|
[ T{
|
||||||
|
feed
|
||||||
|
f
|
||||||
|
"Meerkat"
|
||||||
|
"http://meerkat.oreillynet.com"
|
||||||
|
V{
|
||||||
|
T{
|
||||||
|
entry
|
||||||
|
f
|
||||||
|
"XML: A Disruptive Technology"
|
||||||
|
"http://c.moreover.com/click/here.pl?r123"
|
||||||
|
"\n XML is placing increasingly heavy loads on the existing technical\n infrastructure of the Internet.\n "
|
||||||
|
f
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} ] [ "apps/rss/rss1.xml" resource-path load-news-file ] unit-test
|
||||||
|
[ T{
|
||||||
|
feed
|
||||||
|
f
|
||||||
|
"dive into mark"
|
||||||
|
"http://example.org/"
|
||||||
|
V{
|
||||||
|
T{
|
||||||
|
entry
|
||||||
|
f
|
||||||
|
"Atom draft-07 snapshot"
|
||||||
|
"http://example.org/2005/04/02/atom"
|
||||||
|
"\n <div xmlns=\"http://www.w3.org/1999/xhtml\">\n <p><i>[Update: The Atom draft is finished.]</i></p>\n </div>\n "
|
||||||
|
|
||||||
|
"2003-12-13T08:29:29-04:00"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} ] [ "apps/rss/atom.xml" resource-path load-news-file ] unit-test
|
||||||
|
[ " & & hi" ] [ " & & hi" &>& ] unit-test
|
||||||
|
|
@ -0,0 +1,3 @@
|
||||||
|
PROVIDE: apps/show-dataflow
|
||||||
|
{ +files+ { "print-dataflow.factor" "show-dataflow.factor" } }
|
||||||
|
{ +tests+ { "tests.factor" } } ;
|
||||||
|
|
@ -1,7 +1,9 @@
|
||||||
IN: print-dataflow
|
! Copyright (C) 2006, 2007 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
IN: show-dataflow
|
||||||
USING: generic hashtables inference io kernel kernel-internals
|
USING: generic hashtables inference io kernel kernel-internals
|
||||||
math namespaces prettyprint sequences styles vectors words
|
math namespaces prettyprint prettyprint-internals sequences
|
||||||
optimizer ;
|
styles vectors words optimizer ;
|
||||||
|
|
||||||
! A simple tool for turning dataflow IR into quotations, for
|
! A simple tool for turning dataflow IR into quotations, for
|
||||||
! debugging purposes.
|
! debugging purposes.
|
||||||
|
|
@ -11,7 +13,7 @@ GENERIC: node>quot ( ? node -- )
|
||||||
TUPLE: comment node text ;
|
TUPLE: comment node text ;
|
||||||
|
|
||||||
M: comment pprint*
|
M: comment pprint*
|
||||||
"( " over comment-text " )" append3
|
"( " over comment-text " )" 3append
|
||||||
swap comment-node presented associate
|
swap comment-node presented associate
|
||||||
styled-text ;
|
styled-text ;
|
||||||
|
|
||||||
|
|
@ -79,7 +81,7 @@ M: object node>quot dup class word-name comment, ;
|
||||||
: dataflow>quot ( node ? -- quot )
|
: dataflow>quot ( node ? -- quot )
|
||||||
[ swap (dataflow>quot) ] [ ] make ;
|
[ swap (dataflow>quot) ] [ ] make ;
|
||||||
|
|
||||||
: dataflow. ( quot ? -- )
|
: print-dataflow ( quot ? -- )
|
||||||
#! Print dataflow IR for a quotation. Flag indicates if
|
#! Print dataflow IR for a quotation. Flag indicates if
|
||||||
#! annotations should be printed or not.
|
#! annotations should be printed or not.
|
||||||
>r dataflow optimize r> dataflow>quot . ;
|
>r dataflow optimize r> dataflow>quot . ;
|
||||||
|
|
@ -1,11 +1,11 @@
|
||||||
! Copyright (C) 2006 Slava Pestov.
|
! Copyright (C) 2006, 2007 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
IN: gadgets-dataflow
|
IN: show-dataflow
|
||||||
USING: namespaces arrays sequences io inference math kernel
|
USING: namespaces arrays sequences io inference math kernel
|
||||||
generic prettyprint words gadgets opengl gadgets-panes
|
generic prettyprint words gadgets opengl gadgets-panes
|
||||||
gadgets-labels gadgets-theme gadgets-presentations
|
gadgets-labels gadgets-theme gadgets-presentations
|
||||||
gadgets-buttons gadgets-borders gadgets-scrolling
|
gadgets-buttons gadgets-borders gadgets-scrolling
|
||||||
gadgets-workspace optimizer models help ;
|
optimizer models help ;
|
||||||
|
|
||||||
GENERIC: node>gadget* ( height node -- gadget )
|
GENERIC: node>gadget* ( height node -- gadget )
|
||||||
|
|
||||||
|
|
@ -78,8 +78,7 @@ TUPLE: node-gadget value height ;
|
||||||
C: node-gadget ( gadget node height -- gadget )
|
C: node-gadget ( gadget node height -- gadget )
|
||||||
[ set-node-gadget-height ] keep
|
[ set-node-gadget-height ] keep
|
||||||
[ set-node-gadget-value ] keep
|
[ set-node-gadget-value ] keep
|
||||||
swap <default-border> over set-gadget-delegate
|
swap <default-border> over set-gadget-delegate ;
|
||||||
dup faint-boundary ;
|
|
||||||
|
|
||||||
M: node-gadget pref-dim*
|
M: node-gadget pref-dim*
|
||||||
dup delegate pref-dim
|
dup delegate pref-dim
|
||||||
|
|
@ -111,10 +110,6 @@ M: #push node-presents >#push< first ;
|
||||||
<presentation>
|
<presentation>
|
||||||
] 2map ;
|
] 2map ;
|
||||||
|
|
||||||
: <node-presentation> ( node -- gadget )
|
|
||||||
class [ word-name <label> ] keep <link>
|
|
||||||
<presentation> ;
|
|
||||||
|
|
||||||
: default-node-content ( node -- gadget )
|
: default-node-content ( node -- gadget )
|
||||||
dup node-children <child-nodes>
|
dup node-children <child-nodes>
|
||||||
swap class word-name <label> add* make-pile
|
swap class word-name <label> add* make-pile
|
||||||
|
|
@ -169,7 +164,7 @@ DEFER: (compute-heights)
|
||||||
! Then we create gadgets for every node
|
! Then we create gadgets for every node
|
||||||
: node>gadget ( height node -- gadget )
|
: node>gadget ( height node -- gadget )
|
||||||
[ node>gadget* ] keep node-presents
|
[ node>gadget* ] keep node-presents
|
||||||
[ <presentation> ] when* ;
|
[ <presentation> dup faint-boundary ] when* ;
|
||||||
|
|
||||||
: print-node ( d-height node -- )
|
: print-node ( d-height node -- )
|
||||||
dup full-height-node? [
|
dup full-height-node? [
|
||||||
|
|
@ -177,7 +172,7 @@ DEFER: (compute-heights)
|
||||||
] [
|
] [
|
||||||
[ node-in-d length - <height-gadget> ] 2keep
|
[ node-in-d length - <height-gadget> ] 2keep
|
||||||
node>gadget swap 2array
|
node>gadget swap 2array
|
||||||
make-pile 1 over set-pack-fill
|
make-filled-pile
|
||||||
] if , ;
|
] if , ;
|
||||||
|
|
||||||
: <dataflow-graph> ( node -- gadget )
|
: <dataflow-graph> ( node -- gadget )
|
||||||
|
|
@ -187,31 +182,25 @@ DEFER: (compute-heights)
|
||||||
] { } make
|
] { } make
|
||||||
make-shelf 1 over set-pack-align ;
|
make-shelf 1 over set-pack-align ;
|
||||||
|
|
||||||
! The UI tool
|
|
||||||
TUPLE: dataflow-gadget history ;
|
|
||||||
|
|
||||||
dataflow-gadget "toolbar" {
|
|
||||||
{ "Back" T{ key-down f { C+ } "b" } [ dataflow-gadget-history go-back ] }
|
|
||||||
{ "Forward" T{ key-down f { C+ } "f" } [ dataflow-gadget-history go-forward ] }
|
|
||||||
} define-commands
|
|
||||||
|
|
||||||
: <dataflow-pane> ( history -- gadget )
|
|
||||||
gadget get dataflow-gadget-history
|
|
||||||
[ <dataflow-graph> gadget. ]
|
|
||||||
<pane-control> ;
|
|
||||||
|
|
||||||
C: dataflow-gadget ( -- gadget )
|
|
||||||
f <history> over set-dataflow-gadget-history {
|
|
||||||
{ [ <dataflow-pane> ] f [ <scroller> ] @center }
|
|
||||||
} make-frame* ;
|
|
||||||
|
|
||||||
M: dataflow-gadget call-tool* ( node dataflow -- )
|
|
||||||
dup dataflow-gadget-history add-history
|
|
||||||
dataflow-gadget-history set-model ;
|
|
||||||
|
|
||||||
M: dataflow-gadget tool-help drop "ui-dataflow" ;
|
|
||||||
|
|
||||||
IN: tools
|
|
||||||
|
|
||||||
: show-dataflow ( quot -- )
|
: show-dataflow ( quot -- )
|
||||||
dataflow optimize dataflow-gadget call-tool ;
|
dataflow optimize <dataflow-graph> gadget. ;
|
||||||
|
|
||||||
|
! Operations
|
||||||
|
[ compound? ] H{
|
||||||
|
{ +name+ "Word dataflow" }
|
||||||
|
{ +quot+ [ word-def show-dataflow ] }
|
||||||
|
{ +listener+ t }
|
||||||
|
} define-operation
|
||||||
|
|
||||||
|
[ quotation? ] H{
|
||||||
|
{ +name+ "Quotation dataflow" }
|
||||||
|
{ +quot+ [ show-dataflow ] }
|
||||||
|
{ +listener+ t }
|
||||||
|
} define-operation
|
||||||
|
|
||||||
|
[ [ node? ] is? ] H{
|
||||||
|
{ +primary+ t }
|
||||||
|
{ +name+ "Show dataflow" }
|
||||||
|
{ +quot+ [ <dataflow-graph> gadget. ] }
|
||||||
|
{ +listener+ t }
|
||||||
|
} define-operation
|
||||||
|
|
@ -0,0 +1,9 @@
|
||||||
|
IN: temporary
|
||||||
|
USING: show-dataflow math kernel words test kernel-internals ;
|
||||||
|
|
||||||
|
[ ] [ [ 2 ] t print-dataflow ] unit-test
|
||||||
|
[ ] [ [ 3 + ] t print-dataflow ] unit-test
|
||||||
|
[ ] [ [ drop ] t print-dataflow ] unit-test
|
||||||
|
[ ] [ [ [ sq ] [ abs ] if ] t print-dataflow ] unit-test
|
||||||
|
[ ] [ [ { [ sq ] [ abs ] } dispatch ] t print-dataflow ] unit-test
|
||||||
|
[ ] [ [ 0 0 / ] t print-dataflow ] unit-test
|
||||||
|
|
@ -1332,7 +1332,7 @@ SYMBOL: $4
|
||||||
#! Given an instruction string, return the emulation quotation for
|
#! Given an instruction string, return the emulation quotation for
|
||||||
#! it. This will later be expanded to produce the disassembly and
|
#! it. This will later be expanded to produce the disassembly and
|
||||||
#! assembly quotations.
|
#! assembly quotations.
|
||||||
8080-generator-parser some parse force call ;
|
8080-generator-parser some parse call ;
|
||||||
|
|
||||||
SYMBOL: last-instruction
|
SYMBOL: last-instruction
|
||||||
SYMBOL: last-opcode
|
SYMBOL: last-opcode
|
||||||
|
|
@ -0,0 +1,11 @@
|
||||||
|
REQUIRES: libs/parser-combinators libs/concurrency ;
|
||||||
|
|
||||||
|
PROVIDE: apps/space-invaders
|
||||||
|
{ +files+ {
|
||||||
|
"cpu-8080.factor"
|
||||||
|
"space-invaders.factor"
|
||||||
|
} } ;
|
||||||
|
|
||||||
|
USE: space-invaders
|
||||||
|
|
||||||
|
MAIN: apps/space-invaders run ;
|
||||||
|
|
@ -323,5 +323,5 @@ M: invaders-gadget ungraft* ( gadget -- )
|
||||||
t swap set-invaders-gadget-quit? ;
|
t swap set-invaders-gadget-quit? ;
|
||||||
|
|
||||||
: run ( -- )
|
: run ( -- )
|
||||||
<space-invaders> "invaders.rom" over load-rom <invaders-gadget>
|
<space-invaders> "apps/space-invaders/invaders.rom" resource-path over load-rom <invaders-gadget>
|
||||||
"Space Invaders" open-titled-window ;
|
"Space Invaders" open-window ;
|
||||||
|
|
@ -1,9 +1,9 @@
|
||||||
! Copyright (C) 2006 Alex Chapman
|
! Copyright (C) 2006 Alex Chapman
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
|
||||||
REQUIRES: contrib/lazy-lists ;
|
REQUIRES: libs/lazy-lists ;
|
||||||
|
|
||||||
PROVIDE: contrib/tetris
|
PROVIDE: apps/tetris
|
||||||
{ +files+ {
|
{ +files+ {
|
||||||
"tetris-colours.factor"
|
"tetris-colours.factor"
|
||||||
"tetromino.factor"
|
"tetromino.factor"
|
||||||
|
|
@ -21,4 +21,4 @@ PROVIDE: contrib/tetris
|
||||||
|
|
||||||
USE: tetris-gadget
|
USE: tetris-gadget
|
||||||
|
|
||||||
MAIN: contrib/tetris tetris-window ;
|
MAIN: apps/tetris tetris-window ;
|
||||||
|
|
@ -46,5 +46,5 @@ M: tetris-gadget graft* ( gadget -- )
|
||||||
M: tetris-gadget ungraft* ( gadget -- )
|
M: tetris-gadget ungraft* ( gadget -- )
|
||||||
t swap set-tetris-gadget-quit? ;
|
t swap set-tetris-gadget-quit? ;
|
||||||
|
|
||||||
: tetris-window ( -- ) <default-tetris> <tetris-gadget> "Tetris" open-titled-window ;
|
: tetris-window ( -- ) <default-tetris> <tetris-gadget> "Tetris" open-window ;
|
||||||
|
|
||||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue