diff options
author | John Benediktsson <mrjbq7@gmail.com> | 2018-01-22 08:00:03 -0800 |
---|---|---|
committer | GitHub <noreply@github.com> | 2018-01-22 08:00:03 -0800 |
commit | 657ef7cfae11d462dc829f9b394145eadc6e1a53 (patch) | |
tree | 80ad0a48aa743240f1272f53c29490e0ddc2f9e2 | |
parent | cca11f7e0cb2422e9780893d12cfb48210ec716e (diff) | |
parent | 3f35c1d585ef3f205e32ca5784363ad81c5f4390 (diff) |
Merge pull request #1 from AlexIljin/master
Remove resurrected vocabs
-rw-r--r-- | boolean-expr/authors.txt | 1 | ||||
-rw-r--r-- | boolean-expr/boolean-expr.factor | 95 | ||||
-rw-r--r-- | boolean-expr/summary.txt | 1 | ||||
-rw-r--r-- | dragdrop-listener/dragdrop-listener.factor | 74 | ||||
-rw-r--r-- | dragdrop-listener/platforms.txt | 1 |
5 files changed, 0 insertions, 172 deletions
diff --git a/boolean-expr/authors.txt b/boolean-expr/authors.txt deleted file mode 100644 index 1901f27..0000000 --- a/boolean-expr/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/boolean-expr/boolean-expr.factor b/boolean-expr/boolean-expr.factor deleted file mode 100644 index 33e5e92..0000000 --- a/boolean-expr/boolean-expr.factor +++ /dev/null @@ -1,95 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays classes kernel sequences sets -io prettyprint multi-methods ; -IN: boolean-expr - -! Demonstrates the use of Unicode symbols in source files, and -! multi-method dispatch. - -TUPLE: ⋀ x y ; -TUPLE: ⋁ x y ; -TUPLE: ¬ x ; - -SINGLETONS: ⊤ ⊥ ; - -SINGLETONS: P Q R S T U V W X Y Z ; - -UNION: □ ⋀ ⋁ ¬ ⊤ ⊥ P Q R S T U V W X Y Z ; - -GENERIC: ⋀ ( x y -- expr ) - -METHOD: ⋀ { ⊤ □ } nip ; -METHOD: ⋀ { □ ⊤ } drop ; -METHOD: ⋀ { ⊥ □ } drop ; -METHOD: ⋀ { □ ⊥ } nip ; - -METHOD: ⋀ { ⋁ □ } [ [ x>> ] dip ⋀ ] [ [ y>> ] dip ⋀ ] 2bi ⋁ ; -METHOD: ⋀ { □ ⋁ } [ x>> ⋀ ] [ y>> ⋀ ] 2bi ⋁ ; - -METHOD: ⋀ { □ □ } \ ⋀ boa ; - -GENERIC: ⋁ ( x y -- expr ) - -METHOD: ⋁ { ⊤ □ } drop ; -METHOD: ⋁ { □ ⊤ } nip ; -METHOD: ⋁ { ⊥ □ } nip ; -METHOD: ⋁ { □ ⊥ } drop ; - -METHOD: ⋁ { □ □ } \ ⋁ boa ; - -GENERIC: ¬ ( x -- expr ) - -METHOD: ¬ { ⊤ } drop ⊥ ; -METHOD: ¬ { ⊥ } drop ⊤ ; - -METHOD: ¬ { ⋀ } [ x>> ¬ ] [ y>> ¬ ] bi ⋁ ; -METHOD: ¬ { ⋁ } [ x>> ¬ ] [ y>> ¬ ] bi ⋀ ; - -METHOD: ¬ { □ } \ ¬ boa ; - -: → ( x y -- expr ) ¬ ⋀ ; -: ⊕ ( x y -- expr ) [ ⋁ ] [ ⋀ ¬ ] 2bi ⋀ ; -: ≣ ( x y -- expr ) [ ⋀ ] [ [ ¬ ] bi@ ⋀ ] 2bi ⋁ ; - -GENERIC: (cnf) ( expr -- cnf ) - -METHOD: (cnf) { ⋀ } [ x>> (cnf) ] [ y>> (cnf) ] bi append ; -METHOD: (cnf) { □ } 1array ; - -GENERIC: cnf ( expr -- cnf ) - -METHOD: cnf { ⋁ } [ x>> cnf ] [ y>> cnf ] bi append ; -METHOD: cnf { □ } (cnf) 1array ; - -GENERIC: satisfiable? ( expr -- ? ) - -METHOD: satisfiable? { ⊤ } drop t ; -METHOD: satisfiable? { ⊥ } drop f ; - -: partition ( seq quot -- left right ) - [ [ not ] compose filter ] [ filter ] 2bi ; inline - -: (satisfiable?) ( seq -- ? ) - [ \ ¬ instance? ] partition [ x>> ] map intersect empty? ; - -METHOD: satisfiable? { □ } - cnf [ (satisfiable?) ] any? ; - -GENERIC: (expr.) ( expr -- ) - -METHOD: (expr.) { □ } pprint ; - -: op. ( expr -- ) - "(" write - [ x>> (expr.) ] - [ bl class pprint bl ] - [ y>> (expr.) ] - tri - ")" write ; - -METHOD: (expr.) { ⋀ } op. ; -METHOD: (expr.) { ⋁ } op. ; -METHOD: (expr.) { ¬ } [ class pprint ] [ x>> (expr.) ] bi ; - -: expr. ( expr -- ) (expr.) nl ; diff --git a/boolean-expr/summary.txt b/boolean-expr/summary.txt deleted file mode 100644 index 9b51186..0000000 --- a/boolean-expr/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Simple boolean expression evaluator and simplifier diff --git a/dragdrop-listener/dragdrop-listener.factor b/dragdrop-listener/dragdrop-listener.factor deleted file mode 100644 index 5f3f12b..0000000 --- a/dragdrop-listener/dragdrop-listener.factor +++ /dev/null @@ -1,74 +0,0 @@ -USING: alien.strings io.encodings.utf16n windows.com -windows.com.wrapper combinators windows.kernel32 windows.ole32 -windows.shell32 kernel accessors windows.types -prettyprint namespaces ui.tools.listener ui.tools.workspace -alien.data alien sequences math classes.struct ; -SPECIALIZED-ARRAY: WCHAR -IN: windows.dragdrop-listener - -: filenames-from-hdrop ( hdrop -- filenames ) - dup 0xFFFFFFFF f 0 DragQueryFile ! get count of files - [ - 2dup f 0 DragQueryFile 1 + ! get size of filename buffer - dup WCHAR <c-array> - [ swap DragQueryFile drop ] keep - utf16n alien>string - ] with map ; - -: filenames-from-data-object ( data-object -- filenames ) - FORMATETC <struct> - CF_HDROP >>cfFormat - f >>ptd - DVASPECT_CONTENT >>dwAspect - -1 >>lindex - TYMED_HGLOBAL >>tymed - STGMEDIUM <struct> - [ IDataObject::GetData ] keep swap succeeded? [ - dup data>> - [ filenames-from-hdrop ] with-global-lock - swap ReleaseStgMedium - ] [ drop f ] if ; - -TUPLE: listener-dragdrop hWnd last-drop-effect ; - -: <listener-dragdrop> ( hWnd -- object ) - DROPEFFECT_NONE listener-dragdrop construct-boa ; - -SYMBOL: +listener-dragdrop-wrapper+ -{ - { "IDropTarget" { - [ ! DragEnter - [ - 2drop - filenames-from-data-object - length 1 = [ DROPEFFECT_COPY ] [ DROPEFFECT_NONE ] if - dup 0 - ] dip set-ulong-nth - >>last-drop-effect drop - S_OK - ] [ ! DragOver - [ 2drop last-drop-effect>> 0 ] dip set-ulong-nth - S_OK - ] [ ! DragLeave - drop S_OK - ] [ ! Drop - [ - 2drop nip - filenames-from-data-object - dup length 1 = [ - first unparse [ "USE: parser " % % " run-file" % ] "" make - eval-listener - DROPEFFECT_COPY - ] [ 2drop DROPEFFECT_NONE ] if - 0 - ] dip set-ulong-nth - S_OK - ] - } } -} <com-wrapper> +listener-dragdrop-wrapper+ set-global - -: dragdrop-listener-window ( -- ) - get-workspace parent>> handle>> hWnd>> - dup <listener-dragdrop> - +listener-dragdrop-wrapper+ get-global com-wrap - [ RegisterDragDrop ole32-error ] with-com-interface ; diff --git a/dragdrop-listener/platforms.txt b/dragdrop-listener/platforms.txt deleted file mode 100644 index 8e1a559..0000000 --- a/dragdrop-listener/platforms.txt +++ /dev/null @@ -1 +0,0 @@ -windows |