]> gitweb.factorcode.org Git - factor.git/commitdiff
font syntax for gadgets
authorSam Anklesaria <sam@Tintin.local>
Fri, 31 Jul 2009 16:41:50 +0000 (11:41 -0500)
committerSam Anklesaria <sam@Tintin.local>
Fri, 31 Jul 2009 16:41:50 +0000 (11:41 -0500)
extra/fonts/syntax/authors.txt [new file with mode: 0644]
extra/fonts/syntax/summary.txt [new file with mode: 0644]
extra/fonts/syntax/syntax-docs.factor [new file with mode: 0644]
extra/fonts/syntax/syntax.factor [new file with mode: 0644]

diff --git a/extra/fonts/syntax/authors.txt b/extra/fonts/syntax/authors.txt
new file mode 100644 (file)
index 0000000..ce0899f
--- /dev/null
@@ -0,0 +1 @@
+Sam Anklesaria
\ No newline at end of file
diff --git a/extra/fonts/syntax/summary.txt b/extra/fonts/syntax/summary.txt
new file mode 100644 (file)
index 0000000..35dcf4e
--- /dev/null
@@ -0,0 +1 @@
+Syntax for modifying gadget fonts
\ No newline at end of file
diff --git a/extra/fonts/syntax/syntax-docs.factor b/extra/fonts/syntax/syntax-docs.factor
new file mode 100644 (file)
index 0000000..7edd6d7
--- /dev/null
@@ -0,0 +1,6 @@
+USING: help.syntax help.markup ;
+IN: fonts.syntax
+
+HELP: FONT:
+{ $syntax "\"testing\" <label> FONT: 18 serif bold ... ;" }
+{ $description "Used after a gadget to change font settings.  Attributes can be in any order: the first number is set as the size, the style attributes like bold and italic will set the bold? and italic? slots, and font-names like serif or monospace will set the name slot." } ;
\ No newline at end of file
diff --git a/extra/fonts/syntax/syntax.factor b/extra/fonts/syntax/syntax.factor
new file mode 100644 (file)
index 0000000..1cda01d
--- /dev/null
@@ -0,0 +1,16 @@
+USING: accessors arrays classes.algebraic combinators io.styles
+kernel math parser sequences fry ;
+IN: fonts.syntax
+
+DATA: fontname serif | monospace ;
+
+: install ( object quot -- quot/? ) over [ curry ] [ 2drop [ ] ] if ;
+
+: >>name* ( object fontname -- object ) name>> >>name ;
+
+SYNTAX: FONT: \ ; parse-until {
+    [ [ number? ] find nip [ >>size ] install ]
+    [ [ italic = ] find nip [ >>italic? ] install ]
+    [ [ bold = ] find nip [ >>bold? ] install ]
+    [ [ fontname? ] find nip [ >>name* ] install ]
+} cleave 4array concat '[ dup font>> @ drop ] over push-all ;