--- /dev/null
+USING: accessors ui ui.gadgets ui.gadgets.labels ui.gadgets.buttons ui.gadgets.packs locals sequences io.styles ;
+IN: ui.gadgets.alerts
+:: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align string <label> { "sans-serif" plain 18 } >>font { 200 100 } >>pref-dim add-gadget
+ "okay" [ close-window ] quot append <bevel-button> add-gadget "" open-window ;
\ No newline at end of file
--- /dev/null
+USING: accessors kernel fry math models ui.gadgets ui.gadgets.books ui.gadgets.buttons ;
+IN: ui.gadgets.book-extras
+: <book*> ( pages -- book ) 0 <model> <book> ;
+: |<< ( book -- ) 0 swap set-control-value ;
+: next ( book -- ) model>> [ 1 + ] change-model ;
+: prev ( book -- ) model>> [ 1 - ] change-model ;
+: (book-t) ( quot -- quot ) '[ : owner ( gadget -- book ) parent>> dup book? [ owner ] unless ; owner @ ] ;
+: <book-btn> ( label quot -- button ) (book-t) <button> ;
+: <book-bevel-btn> ( label quot -- button ) (book-t) <bevel-button> ;
+: >>> ( label -- button ) [ next ] <book-btn> ;
+: <<< ( label -- button ) [ prev ] <book-btn> ;
\ No newline at end of file
--- /dev/null
+USING: accessors sequences namespaces ui.render opengl fry ;
+IN: ui.utils
+SYMBOLS: width height ;
+: store-dim ( gadget -- ) dim>> [ first width set ] [ second height set ] bi ;
+: with-dim ( gadget quot -- ) '[ _ store-dim @ ] with-scope ;
+: with-w/h ( gadget quot -- ) '[ origin get _ with-translation ] with-dim ;
\ No newline at end of file
--- /dev/null
+USING: accessors arrays cocoa.dialogs combinators continuations
+fry grouping io.encodings.utf8 io.files io.styles kernel math
+math.parser models models.filter models.history namespaces random
+sequences splitting ui ui.gadgets.alerts ui.gadgets.book-extras
+ui.gadgets.books ui.gadgets.buttons ui.gadgets.frames
+ui.gadgets.grids ui.gadgets.labels ui.gadgets.tracks ui.gestures ;
+
+IN: drills
+SYMBOLS: it startLength ;
+: big ( gadget -- gadget ) { "sans-serif" plain 30 } >>font ;
+: card ( model quot -- button ) <filter> <label-control> big [ next ] <book-btn> ;
+: op ( quot str -- gadget ) <label> big swap <book-bevel-btn> ;
+
+: show ( model -- gadget ) dup it set-global [ random ] <filter>
+ { [ [ first ] card ]
+ [ [ [ second ] [ drop [ "malformed input" throw ] "Malformed Input" alert ] recover ] card ]
+ [ '[ |<< [ it get [
+ _ value>> swap remove
+ [ [ it get go-back ] "Drill Complete" alert return ] when-empty
+ ] change-model ] with-return ] "Yes" op ]
+ [ '[ |<< it get _ model-changed ] "No" op ] } cleave
+2array { 1 0 } <track> swap [ 0.5 track-add ] each
+3array <book*> <frame> { 450 175 } >>pref-dim swap @center grid-add
+it get [ length startLength get swap - number>string "/" startLength get number>string 3append ] <filter> <label-control> @bottom grid-add ;
+
+: drill ( -- ) [
+ open-panel [
+ [ utf8 file-lines [ "\t" split
+ [ " " split 4 group [ " " join ] map ] map ] map ] map concat dup [ [ first ] [ second ] bi swap 2array ] map append
+ [ length startLength set-global ] keep <history> [ add-history ] [ show ] bi
+ "Got it?" open-window
+ ] when*
+] with-ui ;
+
+
+MAIN: drill
+
+
+! FIXME: command-line opening
+! TODO: Menu bar
+! TODO: Pious hot-buttons
\ No newline at end of file
--- /dev/null
+Sam Anklesaria
\ No newline at end of file
--- /dev/null
+USING: peg.ebnf help.syntax help.markup strings ;
+IN: peg-lexer
+ABOUT: "peg-lexer"
+
+HELP: ON-BNF:
+{ $syntax "ON-BNF: word ... ;ON-BNF" }
+{ $description "Creates a parsing word using a parser for lexer control, adding the resulting ast to the stack. Parser syntax is as in " { $link POSTPONE: EBNF: } } ;
+
+HELP: create-bnf
+{ $values { "word" string } { "parser" parser } }
+{ $description "Runtime equivalent of " { $link POSTPONE: ON-BNF: } " also useful with manually constructed parsers." } ;
+
+HELP: factor
+{ $description "Tokenizer that acts like standard factor lexer, separating tokens by whitespace." } ;
\ No newline at end of file
--- /dev/null
+USING: tools.test peg-lexer.test-parsers ;
+IN: peg-lexer.tests
+
+{ V{ "1234" "-end" } } [
+ test1 1234-end
+] unit-test
+
+{ V{ 1234 53 } } [
+ test2 12345
+] unit-test
+
+{ V{ "heavy" "duty" "testing" } } [
+ test3 heavy duty testing
+] unit-test
\ No newline at end of file
--- /dev/null
+USING: hashtables assocs sequences locals math accessors multiline delegate strings
+delegate.protocols kernel peg peg.ebnf lexer namespaces combinators parser words ;
+IN: peg-lexer
+
+TUPLE: lex-hash hash ;
+CONSULT: assoc-protocol lex-hash hash>> ;
+: <lex-hash> ( a -- lex-hash ) lex-hash boa ;
+
+: pos-or-0 ( neg? -- pos/0 ) dup 0 < [ drop 0 ] when ;
+
+:: prepare-pos ( v i -- c l )
+ [let | n [ i v head-slice ] |
+ v CHAR: \n n last-index -1 or 1+ -
+ n [ CHAR: \n = ] count 1+ ] ;
+
+: store-pos ( v a -- ) input swap at prepare-pos
+ lexer get [ (>>line) ] keep (>>column) ;
+
+M: lex-hash set-at swap {
+ { pos [ store-pos ] }
+ [ swap hash>> set-at ] } case ;
+
+:: at-pos ( t l c -- p ) t l head-slice [ length ] map sum l 1- + c + ;
+
+M: lex-hash at* swap {
+ { input [ drop lexer get text>> "\n" join t ] }
+ { pos [ drop lexer get [ text>> ] [ line>> 1- ] [ column>> 1+ ] tri at-pos t ] }
+ [ swap hash>> at* ] } case ;
+
+: with-global-lexer ( quot -- result )
+ [ f lrstack set
+ V{ } clone error-stack set H{ } clone \ heads set
+ H{ } clone \ packrat set ] f make-assoc <lex-hash>
+ swap bind ; inline
+
+: parse* ( parser -- ast ) compile
+ [ execute [ error-stack get first throw ] unless* ] with-global-lexer
+ ast>> ;
+
+: create-bnf ( name parser -- ) reset-tokenizer [ lexer get skip-blank parse* parsed ] curry
+ define word make-parsing ;
+
+: ON-BNF: CREATE-WORD reset-tokenizer ";ON-BNF" parse-multiline-string parse-ebnf
+ main swap at create-bnf ; parsing
+
+! Tokenizer like standard factor lexer
+EBNF: factor
+space = " " | "\n" | "\t"
+spaces = space* => [[ drop ignore ]]
+chunk = (!(space) .)+ => [[ >string ]]
+expr = spaces chunk
+;EBNF
\ No newline at end of file
--- /dev/null
+Use peg to write parsing words
--- /dev/null
+reflection
\ No newline at end of file
--- /dev/null
+USING: peg-lexer math.parser strings ;
+IN: peg-lexer.test-parsers
+
+ON-BNF: test1
+ num = [1-4]* => [[ >string ]]
+ expr = num ( "-end" | "-done" )
+;ON-BNF
+
+ON-BNF: test2
+ num = [1-4]* => [[ >string string>number ]]
+ expr= num [5-9]
+;ON-BNF
+
+ON-BNF: test3
+ tokenizer = <foreign factor>
+ expr= "heavy" "duty" "testing"
+;ON-BNF
\ No newline at end of file