Merge branch 'master' into modern-harvey
Doug Coleman
commit
bf82be86b1
|
|
@ -1,21 +0,0 @@
|
|||
! Copyright (C) 2008, 2010 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: calendar namespaces models threads kernel init ;
|
||||
IN: calendar.model
|
||||
|
||||
SYMBOL: time
|
||||
|
||||
: (time-thread) ( -- )
|
||||
now time get set-model
|
||||
1 seconds sleep (time-thread) ;
|
||||
|
||||
: time-thread ( -- )
|
||||
[
|
||||
init-namespaces
|
||||
(time-thread)
|
||||
] "Time model update" spawn drop ;
|
||||
|
||||
[
|
||||
f <model> time set-global
|
||||
time-thread
|
||||
] "calendar.model" add-startup-hook
|
||||
|
|
@ -1 +0,0 @@
|
|||
Timestamp model updated every second
|
||||
|
|
@ -43,7 +43,7 @@ HELP: publish
|
|||
}
|
||||
{ $see-also <remote-channel> unpublish } ;
|
||||
|
||||
ARTICLE: { "remote-channels" "remote-channels" } "Remote Channels"
|
||||
ARTICLE: "channels.remote" "Remote Channels"
|
||||
"Remote channels are channels that can be accessed by other Factor instances. It uses distributed concurrency to serialize and send data between channels."
|
||||
$nl
|
||||
"To start a remote node, distributed concurrency must have been started. This can be done using " { $link start-server } "."
|
||||
|
|
@ -61,4 +61,4 @@ $nl
|
|||
{ $snippet "\"myhost.com\" 9001 <node> 123456 <remote-channel>\n\"hello\" over to" }
|
||||
;
|
||||
|
||||
ABOUT: { "remote-channels" "remote-channels" }
|
||||
ABOUT: "channels.remote"
|
||||
|
|
|
|||
|
|
@ -149,7 +149,7 @@ MACRO: smart-map-reduce ( map-reduce-quots -- quot )
|
|||
[ keys ] [ [ [ ] concat-as ] [ ] map-as ] bi dup length dup '[
|
||||
[ first _ cleave ] keep
|
||||
[ @ _ cleave-curry _ spread* ]
|
||||
[ 1 ] 2dip setup-each (each-integer)
|
||||
1 each-from
|
||||
] ;
|
||||
|
||||
MACRO: smart-2reduce ( 2reduce-quots -- quot )
|
||||
|
|
@ -162,5 +162,5 @@ MACRO: smart-2map-reduce ( 2map-reduce-quots -- quot )
|
|||
[ keys ] [ [ [ ] concat-as ] [ ] map-as ] bi dup length dup '[
|
||||
[ [ first ] bi@ _ 2cleave ] 2keep
|
||||
[ @ _ [ cleave-curry ] [ cleave-curry ] bi _ spread* ]
|
||||
[ 1 ] 3dip (2each) (each-integer)
|
||||
1 2each-from
|
||||
] ;
|
||||
|
|
|
|||
|
|
@ -39,10 +39,10 @@ T{ error-type-holder
|
|||
} define-error-type
|
||||
|
||||
: <compiler-error> ( error word -- compiler-error )
|
||||
\ compiler-error <definition-error> ;
|
||||
compiler-error new-source-file-error ;
|
||||
|
||||
: <linkage-error> ( error word -- linkage-error )
|
||||
\ linkage-error <definition-error> ;
|
||||
linkage-error new-source-file-error ;
|
||||
|
||||
: set-linkage-error ( name message word class -- )
|
||||
'[ _ boa ] dip <linkage-error> dup asset>> linkage-errors get set-at ; inline
|
||||
|
|
|
|||
|
|
@ -76,7 +76,7 @@ PRIVATE>
|
|||
2 = [
|
||||
[ first2-unsafe ] dip call
|
||||
] [
|
||||
[ [ first-unsafe 1 ] [ (setup-each) ] bi ] dip
|
||||
[ [ first-unsafe 1 ] [ setup-each ] bi ] dip
|
||||
'[ @ _ keep swap ] (all-integers?) nip
|
||||
] if
|
||||
] if ; inline
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ math system strings sbufs vectors byte-arrays quotations
|
|||
io.streams.byte-array classes.builtin parser lexer
|
||||
classes.predicate classes.union classes.intersection
|
||||
classes.singleton classes.tuple help.vocabs math.parser
|
||||
accessors definitions sets ;
|
||||
accessors definitions sets lists ;
|
||||
IN: help.handbook
|
||||
|
||||
ARTICLE: "conventions" "Conventions"
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@ M: help-lint-error error-type drop +help-lint-failure+ ;
|
|||
<PRIVATE
|
||||
|
||||
: <help-lint-error> ( error topic -- help-lint-error )
|
||||
\ help-lint-error <definition-error> ;
|
||||
help-lint-error new-source-file-error ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
|||
|
|
@ -77,7 +77,7 @@ ALIAS: $slot $snippet
|
|||
[ strong-style get print-element* ] ($span) ;
|
||||
|
||||
: $url ( children -- )
|
||||
first dup >url [
|
||||
[ ?second ] [ first ] bi [ or ] keep >url [
|
||||
dup present href associate url-style get assoc-union
|
||||
[ write-object ] with-style
|
||||
] ($span) ;
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ ALIAS: n*p n*v
|
|||
[ drop length [ <iota> ] keep ]
|
||||
[ nip <reversed> ]
|
||||
[ drop ] 2tri
|
||||
'[ _ _ <slice> _ v* sum ] map reverse! ;
|
||||
'[ _ _ <slice> _ v. ] map reverse! ;
|
||||
|
||||
: p-sq ( p -- p^2 ) dup p* ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -28,11 +28,11 @@ HELP: <delay>
|
|||
{ $description "Creates a new instance of " { $link delay } ". The timeout must elapse from the time the underlying model last changed to when the delay model value is changed and its connections are notified." }
|
||||
{ $examples "See the example in the documentation for " { $link delay } "." } ;
|
||||
|
||||
ARTICLE: "models-delay" "Delay models"
|
||||
ARTICLE: "models.delay" "Delay models"
|
||||
"Delay models are used to implement delayed updating of gadgets in response to user input."
|
||||
{ $subsections
|
||||
delay
|
||||
<delay>
|
||||
} ;
|
||||
|
||||
ABOUT: "models-delay"
|
||||
ABOUT: "models.delay"
|
||||
|
|
|
|||
|
|
@ -156,8 +156,8 @@ $nl
|
|||
"models-impl"
|
||||
"models.arrow"
|
||||
"models.product"
|
||||
"models-range"
|
||||
"models-delay"
|
||||
"models.range"
|
||||
"models.delay"
|
||||
} ;
|
||||
|
||||
ARTICLE: "models-impl" "Implementing models"
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ IN: models.product
|
|||
HELP: product
|
||||
{ $class-description "Product model values are computed by collecting the values from a sequence of underlying models into a new sequence. Product models are automatically updated when underlying models change. Product models are constructed by " { $link <product> } "."
|
||||
$nl
|
||||
"A product model whose children are all " { $link "models-range" } " conforms to the " { $link "range-model-protocol" } " and represents a point in n-dimensional space which is bounded by a rectangle." }
|
||||
"A product model whose children are all " { $link "models.range" } " conforms to the " { $link "range-model-protocol" } " and represents a point in n-dimensional space which is bounded by a rectangle." }
|
||||
{ $examples
|
||||
"The following code displays a pair of sliders, and an updating label showing their current values:"
|
||||
{ $code
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@ HELP: move-by-page
|
|||
{ $description "Adds a multiple of the page size to a range model's current value." }
|
||||
{ $side-effects "range" } ;
|
||||
|
||||
ARTICLE: "models-range" "Range models"
|
||||
ARTICLE: "models.range" "Range models"
|
||||
"Range models ensure their value is a real number within a fixed range."
|
||||
{ $subsections
|
||||
range
|
||||
|
|
@ -63,4 +63,4 @@ ARTICLE: "range-model-protocol" "Range model protocol"
|
|||
set-range-max-value
|
||||
} ;
|
||||
|
||||
ABOUT: "models-range"
|
||||
ABOUT: "models.range"
|
||||
|
|
|
|||
|
|
@ -12,9 +12,9 @@ SYMBOL: deprecation-notes
|
|||
|
||||
deprecation-notes [ H{ } clone ] initialize
|
||||
|
||||
TUPLE: deprecation-note-error < source-file-error ;
|
||||
TUPLE: deprecation-note < source-file-error ;
|
||||
|
||||
M: deprecation-note-error error-type drop +deprecation-note+ ;
|
||||
M: deprecation-note error-type drop +deprecation-note+ ;
|
||||
|
||||
TUPLE: deprecated-usages asset usages ;
|
||||
|
||||
|
|
@ -31,13 +31,13 @@ T{ error-type-holder
|
|||
{ fatal? f }
|
||||
} define-error-type
|
||||
|
||||
: <deprecation-note-error> ( error word -- deprecation-note )
|
||||
\ deprecation-note-error <definition-error> ;
|
||||
: <deprecation-note> ( error word -- deprecation-note )
|
||||
deprecation-note new-source-file-error ;
|
||||
|
||||
: deprecation-note ( word usages -- )
|
||||
[ deprecated-usages boa ]
|
||||
[ drop <deprecation-note-error> ]
|
||||
[ drop deprecation-notes get-global set-at ] 2tri ;
|
||||
: store-deprecation-note ( word usages -- )
|
||||
over [ deprecated-usages boa ] dip
|
||||
[ <deprecation-note> ]
|
||||
[ deprecation-notes get-global set-at ] bi ;
|
||||
|
||||
: clear-deprecation-note ( word -- )
|
||||
deprecation-notes get-global delete-at ;
|
||||
|
|
@ -47,7 +47,8 @@ T{ error-type-holder
|
|||
dup { [ "forgotten" word-prop ] [ deprecated? ] } 1||
|
||||
[ clear-deprecation-note ] [
|
||||
dup def>> uses [ deprecated? ] filter
|
||||
[ clear-deprecation-note ] [ >array deprecation-note ] if-empty
|
||||
[ clear-deprecation-note ]
|
||||
[ store-deprecation-note ] if-empty
|
||||
] if
|
||||
] [ drop ] if ;
|
||||
|
||||
|
|
@ -74,7 +75,7 @@ M: deprecation-observer definitions-changed
|
|||
[ [ check-deprecations ] each ]
|
||||
[ drop initialize-deprecation-notes ] if ;
|
||||
|
||||
[ \ deprecation-observer add-definition-observer ]
|
||||
[ deprecation-observer add-definition-observer ]
|
||||
"tools.deprecation" add-startup-hook
|
||||
|
||||
initialize-deprecation-notes
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@ HELP: :linkage
|
|||
{ :errors :linkage } related-words
|
||||
|
||||
HELP: errors.
|
||||
{ $values { "errors" "a sequence of " { $link source-file-error } " instances" } }
|
||||
{ $values { "errors" { $sequence source-file-error } } }
|
||||
{ $description "Prints a list of errors, grouped by source file." } ;
|
||||
|
||||
ARTICLE: "tools.errors" "Batch error reporting"
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs debugger io kernel sequences source-files.errors
|
||||
summary accessors continuations make math.parser io.styles namespaces
|
||||
compiler.errors prettyprint source-files.errors.debugger command-line ;
|
||||
USING: accessors assocs command-line compiler.errors debugger
|
||||
io kernel namespaces sequences source-files.errors
|
||||
source-files.errors.debugger summary ;
|
||||
IN: tools.errors
|
||||
|
||||
! Tools for source-files.errors. Used by tools.tests and others
|
||||
|
|
|
|||
|
|
@ -1,18 +0,0 @@
|
|||
! Copyright (C) 2009, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: models source-files.errors namespaces models.delay init
|
||||
kernel calendar ;
|
||||
IN: tools.errors.model
|
||||
|
||||
SYMBOLS: (error-list-model) error-list-model ;
|
||||
|
||||
SINGLETON: updater
|
||||
|
||||
M: updater errors-changed
|
||||
drop f (error-list-model) get-global set-model ;
|
||||
|
||||
[
|
||||
f <model> (error-list-model) set-global
|
||||
(error-list-model) get-global 100 milliseconds <delay> error-list-model set-global
|
||||
updater add-error-observer
|
||||
] "tools.errors.model" add-startup-hook
|
||||
|
|
@ -2,13 +2,12 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien alien.c-types alien.data alien.strings
|
||||
arrays assocs cocoa cocoa.application cocoa.classes
|
||||
cocoa.pasteboard cocoa.runtime cocoa.subclassing cocoa.touchbar
|
||||
cocoa.types cocoa.views combinators core-foundation.strings
|
||||
core-graphics core-graphics.types core-text io.encodings.utf8
|
||||
kernel literals locals math math.rectangles namespaces opengl
|
||||
sequences threads ui.gadgets ui.gadgets.private
|
||||
ui.gadgets.worlds ui.gestures ui.private ui.tools.listener
|
||||
vocabs.refresh ;
|
||||
cocoa.pasteboard cocoa.runtime cocoa.subclassing cocoa.types
|
||||
cocoa.views combinators core-foundation.strings core-graphics
|
||||
core-graphics.types core-text io.encodings.utf8 kernel literals
|
||||
locals math math.rectangles namespaces opengl sequences threads
|
||||
ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures
|
||||
ui.private ;
|
||||
IN: ui.backend.cocoa.views
|
||||
|
||||
: send-mouse-moved ( view event -- )
|
||||
|
|
|
|||
|
|
@ -506,7 +506,7 @@ SYMBOL: wm-handlers
|
|||
|
||||
H{ } clone wm-handlers set-global
|
||||
|
||||
: add-wm-handler ( quot wm -- )
|
||||
: add-wm-handler ( quot: ( hWnd Msg wParam lParam -- LRESULT ) wm -- )
|
||||
dup array?
|
||||
[ [ execute( -- wm ) add-wm-handler ] with each ]
|
||||
[ wm-handlers get-global set-at ] if ;
|
||||
|
|
|
|||
|
|
@ -13,7 +13,8 @@ IN: ui.gadgets.editors
|
|||
TUPLE: editor < line-gadget
|
||||
caret-color
|
||||
caret mark
|
||||
focused? blink blink-timer ;
|
||||
focused? blink blink-timer
|
||||
default-text ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
|
@ -199,6 +200,13 @@ TUPLE: selected-line start end first? last? ;
|
|||
] 3bi
|
||||
] if ;
|
||||
|
||||
: draw-default-text? ( editor -- ? )
|
||||
{ [ default-text>> ] [ model>> doc-string empty? ] } 1&& ;
|
||||
|
||||
: draw-default-text ( editor -- )
|
||||
[ font>> clone line-color >>foreground ]
|
||||
[ default-text>> ] bi draw-text ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
M: editor draw-line ( line index editor -- )
|
||||
|
|
@ -206,13 +214,19 @@ M: editor draw-line ( line index editor -- )
|
|||
[ draw-selected-line ] [ nip draw-unselected-line ] if ;
|
||||
|
||||
M: editor draw-gadget*
|
||||
dup draw-default-text? [
|
||||
[ draw-default-text ] [ draw-caret ] bi
|
||||
] [
|
||||
dup compute-selection selected-lines [
|
||||
[ draw-lines ] [ draw-caret ] bi
|
||||
] with-variable ;
|
||||
] with-variable
|
||||
] if ;
|
||||
|
||||
M: editor pref-dim*
|
||||
! Add some space for the caret.
|
||||
[ font>> ] [ control-value ] bi text-dim { 1 0 } v+ ;
|
||||
[ font>> ] keep dup draw-default-text?
|
||||
[ default-text>> ] [ control-value ] if
|
||||
text-dim { 1 0 } v+ ;
|
||||
|
||||
M: editor baseline font>> font-metrics ascent>> ;
|
||||
|
||||
|
|
@ -627,6 +641,10 @@ M: field pref-dim*
|
|||
[ [ line-gadget-width ] [ drop second ] 2bi 2array ]
|
||||
tri border-pref-dim ;
|
||||
|
||||
M: field default-text>> editor>> default-text>> ;
|
||||
|
||||
M: field default-text<< editor>> default-text<< ;
|
||||
|
||||
TUPLE: model-field < field field-model ;
|
||||
|
||||
: <model-field> ( model -- gadget )
|
||||
|
|
@ -644,48 +662,14 @@ M: model-field ungraft*
|
|||
M: model-field model-changed
|
||||
nip [ editor>> editor-string ] [ field-model>> ] bi set-model ;
|
||||
|
||||
TUPLE: action-editor < editor default-text ;
|
||||
|
||||
: <action-editor> ( -- editor )
|
||||
action-editor new-editor ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: draw-default-text? ( editor -- ? )
|
||||
{ [ default-text>> ] [ model>> doc-string empty? ] } 1&& ;
|
||||
|
||||
: draw-default-text ( editor -- )
|
||||
[ font>> clone line-color >>foreground ]
|
||||
[ default-text>> ] bi draw-text ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
M: action-editor draw-gadget*
|
||||
dup draw-default-text? [
|
||||
[ draw-default-text ] [ draw-caret ] bi
|
||||
] [
|
||||
call-next-method
|
||||
] if ;
|
||||
|
||||
M: action-editor pref-dim*
|
||||
dup draw-default-text? [
|
||||
[ font>> ] [ default-text>> ] bi text-dim { 1 0 } v+
|
||||
] [
|
||||
call-next-method
|
||||
] if ;
|
||||
|
||||
TUPLE: action-field < field quot ;
|
||||
|
||||
: <action-field> ( quot: ( string -- ) -- gadget )
|
||||
action-field [ <action-editor> ] dip new-border
|
||||
action-field [ <editor> ] dip new-border
|
||||
dup gadget-child >>editor
|
||||
field-theme
|
||||
swap >>quot ;
|
||||
|
||||
M: action-field default-text>> editor>> default-text>> ;
|
||||
|
||||
M: action-field default-text<< editor>> default-text<< ;
|
||||
|
||||
: invoke-action-field ( field -- )
|
||||
[ editor>> editor-string ]
|
||||
[ editor>> clear-editor ]
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ HELP: labeled-gadget
|
|||
{ $class-description "A labeled gadget can be created by calling " { $link <labeled-gadget> } "." } ;
|
||||
|
||||
HELP: <labeled-gadget>
|
||||
{ $values { "gadget" gadget } { "title" string } { "labeled" "a new " { $link <labeled-gadget> } } }
|
||||
{ $values { "gadget" gadget } { "title" string } { "color" "a color" } { "labeled" "a new " { $link <labeled-gadget> } } }
|
||||
{ $description "Creates a new " { $link labeled-gadget } " display " { $snippet "gadget" } " with " { $snippet "title" } " on top." } ;
|
||||
|
||||
ARTICLE: "ui.gadgets.labeled" "Labeled gadgets"
|
||||
|
|
@ -14,6 +14,7 @@ ARTICLE: "ui.gadgets.labeled" "Labeled gadgets"
|
|||
{ $subsections
|
||||
labeled-gadget
|
||||
<labeled-gadget>
|
||||
<framed-labeled-gadget>
|
||||
} ;
|
||||
|
||||
ABOUT: "ui.gadgets.labeled"
|
||||
|
|
|
|||
|
|
@ -1,9 +1,8 @@
|
|||
! Copyright (C) 2006, 2009 Slava Pestov, 2015 Nicolas Pénet.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors colors.constants kernel system ui.gadgets
|
||||
ui.gadgets.borders ui.gadgets.labels ui.gadgets.packs
|
||||
ui.theme ui.gadgets.tracks ui.pens.gradient
|
||||
ui.pens.solid ui.tools.common ;
|
||||
USING: accessors kernel system ui.gadgets ui.gadgets.borders
|
||||
ui.gadgets.labels ui.gadgets.packs ui.gadgets.tracks
|
||||
ui.pens.gradient ui.pens.solid ui.theme ;
|
||||
IN: ui.gadgets.labeled
|
||||
|
||||
TUPLE: labeled-gadget < track content color ;
|
||||
|
|
@ -43,24 +42,12 @@ M: labeled-gadget focusable-child* content>> ;
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: <labeled> ( gadget title color -- labeled )
|
||||
vertical labeled-gadget new-track with-lines
|
||||
: <labeled-gadget> ( gadget title color -- labeled )
|
||||
vertical labeled-gadget new-track
|
||||
swap >>color
|
||||
add-title-bar
|
||||
swap >>content
|
||||
add-content-area ;
|
||||
|
||||
: <framed-labeled> ( gadget title color -- labeled )
|
||||
<labeled> labeled-border-color <solid> >>boundary ;
|
||||
|
||||
: <labeled-gadget> ( gadget title -- labeled )
|
||||
vertical labeled-gadget new-track with-lines
|
||||
add-title-bar
|
||||
swap [ >>content ] keep
|
||||
vertical <track>
|
||||
add-content
|
||||
{ 5 5 } <border>
|
||||
content-background <solid> >>interior
|
||||
1 track-add
|
||||
labeled-border-color <solid> >>boundary
|
||||
{ 3 3 } <border> ;
|
||||
: <framed-labeled-gadget> ( gadget title color -- labeled )
|
||||
<labeled-gadget> labeled-border-color <solid> >>boundary ;
|
||||
|
|
|
|||
|
|
@ -2,10 +2,10 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators kernel locals math math.rectangles
|
||||
math.vectors memoize models namespaces opengl sequences sorting
|
||||
ui.commands ui.gadgets ui.gadgets.buttons ui.gadgets.glass
|
||||
ui.gadgets.packs ui.gadgets.worlds ui.gadgets.wrappers ui.gestures
|
||||
ui.operations ui.pens ui.pens.solid ui.theme ui.tools.common ;
|
||||
|
||||
ui.commands ui.gadgets ui.gadgets.borders ui.gadgets.buttons
|
||||
ui.gadgets.glass ui.gadgets.packs ui.gadgets.worlds
|
||||
ui.gadgets.wrappers ui.gestures ui.operations ui.pens
|
||||
ui.pens.solid ui.theme ;
|
||||
FROM: ui.gadgets.wrappers => wrapper ;
|
||||
|
||||
IN: ui.gadgets.menus
|
||||
|
|
@ -140,7 +140,7 @@ menu H{
|
|||
: <menu> ( gadgets -- menu )
|
||||
<menu-items> [
|
||||
{ 0 3 } >>gap
|
||||
margins
|
||||
{ 5 5 } <filled-border>
|
||||
menu-border-color <solid> >>boundary
|
||||
menu-background <solid> >>interior
|
||||
menu new-wrapper
|
||||
|
|
|
|||
|
|
@ -32,8 +32,8 @@ TUPLE: search-field < track field ;
|
|||
0 >>fill
|
||||
{ 5 5 } >>gap
|
||||
+baseline+ >>align
|
||||
swap <model-field> 10 >>min-cols >>field
|
||||
dup field>> "Search:" label-on-left 1 track-add
|
||||
swap <model-field> 10 >>min-cols "Search" >>default-text
|
||||
[ >>field ] keep 1 track-add
|
||||
dup <clear-button> f track-add ;
|
||||
|
||||
M: search-field focusable-child* field>> ;
|
||||
|
|
@ -46,26 +46,6 @@ M: search-field handle-gesture
|
|||
{ [ pass-to-table ] [ call-next-method ] } 2&&
|
||||
] [ call-next-method ] if ;
|
||||
|
||||
! A protocol with customizable slots
|
||||
SLOT-PROTOCOL: table-protocol
|
||||
renderer
|
||||
action
|
||||
hook
|
||||
font
|
||||
selection-color
|
||||
focus-border-color
|
||||
mouse-color
|
||||
column-line-color
|
||||
selection-required?
|
||||
single-click?
|
||||
selection
|
||||
min-rows
|
||||
min-cols
|
||||
max-rows
|
||||
max-cols ;
|
||||
|
||||
CONSULT: table-protocol search-table table>> ;
|
||||
|
||||
:: <search-table> ( values renderer quot -- gadget )
|
||||
f <model> :> search
|
||||
vertical search-table new-track
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ HELP: elevator
|
|||
{ $class-description "An elevator is the part of a " { $link slider } " between the up/down arrow buttons, where a " { $link thumb } " may be moved up and down." } ;
|
||||
|
||||
HELP: slider
|
||||
{ $class-description "A slider is a control for graphically manipulating a " { $link "models-range" } "."
|
||||
{ $class-description "A slider is a control for graphically manipulating a " { $link "models.range" } "."
|
||||
$nl
|
||||
"Sliders are created by calling " { $link <slider> } "." } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
Slava Pestov
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
IN: ui.gadgets.slots.tests
|
||||
USING: assocs ui.gadgets.slots tools.test refs ;
|
||||
|
||||
{ t } [ [ ] [ ] { { 1 1 } { 2 2 } { 3 3 } } 2 <value-ref> <slot-editor> slot-editor? ] unit-test
|
||||
|
|
@ -1,14 +1,24 @@
|
|||
USING: specialized-arrays.instances.alien.c-types.int tools.test
|
||||
USING: alien.c-types literals specialized-arrays tools.test
|
||||
ui.pixel-formats ;
|
||||
SPECIALIZED-ARRAY: int
|
||||
IN: ui.pixel-formats.tests
|
||||
|
||||
CONSTANT: attrib-table {
|
||||
{ windowed { 99 } }
|
||||
{ double-buffered { 7 } }
|
||||
{ samples { 100001 } }
|
||||
}
|
||||
|
||||
SYMBOL: garbageword
|
||||
CONSTANT: garbageint 234
|
||||
|
||||
! pixel-format-attributes>int-array
|
||||
{ int-array{ 9 2 99 7 0 } } [
|
||||
{ windowed double-buffered } { 9 2 } attrib-table
|
||||
! it should ignore garbage, even the color-bits because it's not
|
||||
! in the table
|
||||
{ int-array{ 9 2 99 7 100001 2 0 } } [
|
||||
{
|
||||
windowed "garbage" $ garbageint double-buffered
|
||||
garbageword T{ samples f 2 } T{ color-bits f 24 }
|
||||
} { 9 2 } attrib-table
|
||||
pixel-format-attributes>int-array
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
USING: accessors alien.c-types alien.data assocs destructors fry
|
||||
kernel math sequences specialized-arrays ui.backend ;
|
||||
USING: accessors alien.c-types alien.data assocs classes
|
||||
combinators destructors fry kernel math sequences
|
||||
specialized-arrays ui.backend words ;
|
||||
SPECIALIZED-ARRAY: int
|
||||
IN: ui.pixel-formats
|
||||
|
||||
|
|
@ -57,8 +58,18 @@ TUPLE: pixel-format < disposable world handle ;
|
|||
M: pixel-format dispose*
|
||||
[ (free-pixel-format) ] [ f >>handle drop ] bi ;
|
||||
|
||||
: (pixel-format-attribute) ( attribute table -- arr/f )
|
||||
[ dup class-of ] dip at [ swap value>> suffix ] [ drop f ] if* ;
|
||||
|
||||
: pixel-format-attribute>array ( obj table -- arr/f )
|
||||
{
|
||||
{ [ over pixel-format-attribute? ] [ (pixel-format-attribute) ] }
|
||||
{ [ over word? ] [ at ] }
|
||||
[ 2drop f ]
|
||||
} cond ;
|
||||
|
||||
: pixel-format-attributes>int-array ( attrs perm table -- arr )
|
||||
swapd '[ _ at ] map sift concat append
|
||||
swapd '[ _ pixel-format-attribute>array ] map sift concat append
|
||||
! 0 happens to work as a sentinel value for all ui backends.
|
||||
0 suffix int >c-array ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs colors.constants
|
||||
definitions.icons fry help help.topics kernel math.rectangles
|
||||
models.arrow namespaces sequences tools.crossref ui.gadgets
|
||||
ui.gadgets.glass ui.gadgets.labeled ui.gadgets.search-tables
|
||||
ui.gadgets.tables ui.gadgets.wrappers ui.gestures ui.images
|
||||
ui.operations ui.pens.solid ui.theme ui.theme.images ;
|
||||
USING: accessors arrays assocs definitions.icons fry help
|
||||
help.topics kernel math.rectangles models.arrow namespaces
|
||||
sequences tools.crossref ui.gadgets ui.gadgets.glass
|
||||
ui.gadgets.labeled ui.gadgets.search-tables ui.gadgets.tables
|
||||
ui.gadgets.wrappers ui.gestures ui.images ui.operations ui.theme
|
||||
ui.tools.common ;
|
||||
FROM: ui.gadgets.wrappers => wrapper ;
|
||||
IN: ui.tools.browser.popups
|
||||
|
||||
|
|
@ -22,18 +22,18 @@ TUPLE: links-popup < wrapper ;
|
|||
'[
|
||||
@ sort-articles
|
||||
[ dup article-title ] { } map>assoc
|
||||
] <arrow> link-renderer [ second ] <search-table>
|
||||
] <arrow> link-renderer [ second ] <search-table> dup table>>
|
||||
[ invoke-primary-operation ] >>action
|
||||
[ hide-glass ] >>hook
|
||||
t >>selection-required?
|
||||
10 >>min-rows
|
||||
10 >>max-rows
|
||||
30 >>min-cols
|
||||
30 >>max-cols ;
|
||||
30 >>max-cols drop ;
|
||||
|
||||
: <links-popup> ( model quot title -- gadget )
|
||||
[ <links-table> content-background <solid> >>interior ] dip
|
||||
popup-color <labeled> links-popup new-wrapper ;
|
||||
[ <links-table> white-interior ] dip
|
||||
popup-color <framed-labeled-gadget> links-popup new-wrapper ;
|
||||
|
||||
links-popup H{
|
||||
{ T{ key-down f f "ESC" } [ hide-glass ] }
|
||||
|
|
|
|||
|
|
@ -1,8 +1,9 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors classes combinators.short-circuit kernel ui.gadgets
|
||||
ui.gadgets.borders ui.gadgets.scrollers ui.gadgets.tracks
|
||||
ui.pens.solid ui.theme words ;
|
||||
USING: accessors classes combinators.short-circuit kernel ui
|
||||
ui.gadgets ui.gadgets.borders ui.gadgets.scrollers
|
||||
ui.gadgets.tracks ui.pens.solid ui.theme words ;
|
||||
|
||||
IN: ui.tools.common
|
||||
|
||||
: set-tool-dim ( class dim -- )
|
||||
|
|
@ -18,8 +19,11 @@ M: tool pref-dim*
|
|||
|
||||
M: tool layout*
|
||||
[ call-next-method ]
|
||||
[ [ class-of ] [ dim>> ] bi set-tool-dim ]
|
||||
bi ;
|
||||
[
|
||||
dup fullscreen? [ drop ] [
|
||||
[ class-of ] [ dim>> ] bi set-tool-dim
|
||||
] if
|
||||
] bi ;
|
||||
|
||||
SLOT: scroller
|
||||
|
||||
|
|
|
|||
|
|
@ -1,11 +1,12 @@
|
|||
! Copyright (C) 2007, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: colors kernel models tools.deploy.config
|
||||
tools.deploy.config.editor tools.deploy vocabs namespaces
|
||||
models.mapping sequences system accessors fry ui.gadgets ui.render
|
||||
ui.gadgets.packs ui.gadgets.labels ui.gadgets.editors ui.gadgets.borders ui.gadgets.buttons ui.gadgets.toolbar ui.gestures ui.commands assocs
|
||||
ui.gadgets.tracks ui ui.tools.listener ui.tools.browser
|
||||
ui.tools.common ui.gadgets.worlds ;
|
||||
USING: accessors assocs fry kernel models models.mapping
|
||||
namespaces sequences tools.deploy tools.deploy.config
|
||||
tools.deploy.config.editor ui ui.commands ui.gadgets
|
||||
ui.gadgets.borders ui.gadgets.buttons ui.gadgets.editors
|
||||
ui.gadgets.labels ui.gadgets.packs ui.gadgets.toolbar
|
||||
ui.gadgets.worlds ui.gestures ui.tools.browser ui.tools.common
|
||||
ui.tools.listener vocabs ;
|
||||
IN: ui.tools.deploy
|
||||
|
||||
TUPLE: deploy-gadget < pack vocab settings ;
|
||||
|
|
|
|||
|
|
@ -1,17 +1,17 @@
|
|||
! Copyright (C) 2009, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays sequences sorting assocs colors.constants fry
|
||||
combinators combinators.smart combinators.short-circuit editors make
|
||||
memoize compiler.units fonts kernel io.pathnames prettyprint
|
||||
source-files.errors source-files.errors.debugger math.parser init math.order
|
||||
models models.arrow models.arrow.smart models.search models.mapping debugger
|
||||
namespaces summary locals ui ui.commands ui.gadgets ui.gadgets.panes
|
||||
ui.gadgets.tables ui.gadgets.labeled ui.gadgets.tracks ui.gestures
|
||||
ui.operations ui.tools.browser ui.tools.common ui.gadgets.scrollers
|
||||
ui.tools.inspector ui.gadgets.buttons ui.gadgets.borders ui.gadgets.labels
|
||||
ui.gadgets.packs ui.theme ui.gadgets.toolbar ui.gadgets.status-bar
|
||||
ui.baseline-alignment ui.images
|
||||
compiler.errors tools.errors tools.errors.model ;
|
||||
USING: accessors arrays assocs calendar colors.constants
|
||||
combinators combinators.smart compiler.errors debugger editors
|
||||
fry init io.pathnames kernel locals math.parser memoize models
|
||||
models.arrow models.arrow.smart models.delay models.mapping
|
||||
models.search namespaces prettyprint sequences sorting
|
||||
source-files.errors source-files.errors.debugger summary ui
|
||||
ui.commands ui.gadgets ui.gadgets.buttons ui.gadgets.labeled
|
||||
ui.gadgets.labels ui.gadgets.packs ui.gadgets.panes
|
||||
ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.tables
|
||||
ui.gadgets.toolbar ui.gadgets.tracks ui.gestures ui.images
|
||||
ui.operations ui.theme ui.tools.browser ui.tools.common
|
||||
ui.tools.inspector ;
|
||||
IN: ui.tools.error-list
|
||||
|
||||
CONSTANT: source-file-icon
|
||||
|
|
@ -156,7 +156,7 @@ error-display "toolbar" f {
|
|||
[ swap '[ error-type _ at ] filter ] <smart-arrow> ;
|
||||
|
||||
:: <error-list-gadget> ( model -- gadget )
|
||||
vertical \ error-list-gadget new-track
|
||||
vertical error-list-gadget new-track
|
||||
<error-toggle> [ >>error-toggle ] [ >>visible-errors ] bi*
|
||||
dup visible-errors>> model <error-model> >>model
|
||||
f <model> >>source-file
|
||||
|
|
@ -168,16 +168,23 @@ error-display "toolbar" f {
|
|||
error-list vertical <track> with-lines
|
||||
error-list <error-list-toolbar> f track-add
|
||||
error-list source-file-table>> margins <scroller> white-interior
|
||||
"Source files" source-files-color <labeled> 1/4 track-add
|
||||
"Source files" source-files-color <labeled-gadget> 1/4 track-add
|
||||
error-list error-table>> margins <scroller> white-interior
|
||||
"Errors" errors-color <labeled> 1/4 track-add
|
||||
"Errors" errors-color <labeled-gadget> 1/4 track-add
|
||||
error-list error-display>>
|
||||
"Details" details-color <labeled> 1/2 track-add
|
||||
"Details" details-color <labeled-gadget> 1/2 track-add
|
||||
1 track-add ;
|
||||
|
||||
M: error-list-gadget focusable-child*
|
||||
source-file-table>> ;
|
||||
|
||||
SYMBOLS: error-list-model ;
|
||||
|
||||
SINGLETON: error-list-updater
|
||||
|
||||
M: error-list-updater errors-changed
|
||||
drop f error-list-model get-global model>> set-model ;
|
||||
|
||||
: error-list-help ( -- ) "ui.tools.error-list" com-browse ;
|
||||
|
||||
\ error-list-help H{ { +nullary+ t } } define-command
|
||||
|
|
@ -186,14 +193,17 @@ M: error-list-gadget focusable-child*
|
|||
{ T{ key-down f f "F1" } error-list-help }
|
||||
} define-command-map
|
||||
|
||||
MEMO: get-error-list-gadget ( -- gadget )
|
||||
: error-list-window ( -- )
|
||||
error-list-model get-global [ drop all-errors ] <arrow>
|
||||
<error-list-gadget> ;
|
||||
|
||||
[ \ get-error-list-gadget reset-memoized ] "ui.tools.error-list" add-startup-hook
|
||||
<error-list-gadget> "Errors" open-status-window ;
|
||||
|
||||
: show-error-list ( -- )
|
||||
[ get-error-list-gadget eq? ] find-window
|
||||
[ raise-window ] [ get-error-list-gadget "Errors" open-status-window ] if* ;
|
||||
[ error-list-gadget? ] find-window
|
||||
[ raise-window ] [ error-list-window ] if* ;
|
||||
|
||||
\ show-error-list H{ { +nullary+ t } } define-command
|
||||
|
||||
[
|
||||
f <model> 100 milliseconds <delay> error-list-model set-global
|
||||
error-list-updater add-error-observer
|
||||
] "ui.tools.error-list" add-startup-hook
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: help.markup help.syntax ui.commands ui.gadgets.slots
|
||||
ui.gadgets.panes ui.gadgets.editors kernel ;
|
||||
USING: help.markup help.syntax ui.commands
|
||||
ui.gadgets.panes ui.gadgets.editors ui.tools.inspector.slots kernel ;
|
||||
IN: ui.tools.inspector
|
||||
|
||||
ARTICLE: "ui-inspector-edit" "Editing slot values in the inspector"
|
||||
|
|
|
|||
|
|
@ -2,13 +2,13 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs classes combinators fonts fry
|
||||
hashtables inspector io io.styles kernel math.vectors mirrors
|
||||
models models.arrow namespaces prettyprint refs sequences
|
||||
sorting ui ui.commands ui.gadgets ui.gadgets.labeled
|
||||
ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.slots
|
||||
ui.gadgets.status-bar ui.gadgets.tables
|
||||
models models.arrow namespaces prettyprint sequences sorting ui
|
||||
ui.commands ui.gadgets ui.gadgets.labeled ui.gadgets.panes
|
||||
ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.tables
|
||||
ui.gadgets.tables.private ui.gadgets.toolbar ui.gadgets.tracks
|
||||
ui.gadgets.worlds ui.gestures ui.operations ui.theme
|
||||
ui.tools.browser ui.tools.common ;
|
||||
ui.gestures ui.operations ui.theme ui.tools.browser
|
||||
ui.tools.common ui.tools.inspector.slots ;
|
||||
|
||||
IN: ui.tools.inspector
|
||||
|
||||
TUPLE: inspector-gadget < tool table ;
|
||||
|
|
@ -100,8 +100,10 @@ M: inspector-table compute-column-widths
|
|||
add-toolbar
|
||||
swap >>model
|
||||
dup model>> <inspector-table> >>table
|
||||
dup model>> <summary-gadget> margins white-interior "Object" object-color <labeled> f track-add
|
||||
dup table>> <scroller> margins white-interior "Contents" contents-color <labeled> 1 track-add ;
|
||||
dup model>> <summary-gadget> margins white-interior
|
||||
"Object" object-color <labeled-gadget> f track-add
|
||||
dup table>> <scroller> margins white-interior
|
||||
"Contents" contents-color <labeled-gadget> 1 track-add ;
|
||||
|
||||
M: inspector-gadget focusable-child*
|
||||
table>> ;
|
||||
|
|
@ -114,15 +116,6 @@ M: inspector-gadget focusable-child*
|
|||
|
||||
\ com-push H{ { +listener+ t } } define-command
|
||||
|
||||
: slot-editor-window ( close-hook update-hook assoc key key-string -- )
|
||||
[ <value-ref> <slot-editor> ]
|
||||
[
|
||||
<world-attributes>
|
||||
swap "Slot editor: " prepend >>title
|
||||
[ { dialog-window } append ] change-window-controls
|
||||
] bi*
|
||||
open-status-window ;
|
||||
|
||||
: com-edit-slot ( inspector -- )
|
||||
[ close-window ] swap
|
||||
[ '[ _ com-refresh ] ]
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
USING: assocs tools.test ui.tools.inspector.slots refs ;
|
||||
|
||||
{ t } [
|
||||
[ ] [ ] { { 1 1 } { 2 2 } { 3 3 } } 2 <value-ref>
|
||||
<slot-editor> slot-editor?
|
||||
] unit-test
|
||||
|
|
@ -2,9 +2,10 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors eval kernel math.vectors parser prettyprint
|
||||
refs sequences ui.commands ui.gadgets ui.gadgets.editors
|
||||
ui.gadgets.scrollers ui.gadgets.toolbar ui.gadgets.tracks
|
||||
ui.gestures ui.tools.common ;
|
||||
IN: ui.gadgets.slots
|
||||
ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.toolbar
|
||||
ui.gadgets.tracks ui.gadgets.worlds ui.gestures ui.tools.common
|
||||
;
|
||||
IN: ui.tools.inspector.slots
|
||||
|
||||
TUPLE: slot-editor < track ref close-hook update-hook text ;
|
||||
|
||||
|
|
@ -55,14 +56,14 @@ TUPLE: slot-editor < track ref close-hook update-hook text ;
|
|||
} define-command
|
||||
|
||||
: <slot-editor> ( close-hook update-hook ref -- gadget )
|
||||
vertical slot-editor new-track
|
||||
vertical slot-editor new-track with-lines
|
||||
swap >>ref
|
||||
swap >>update-hook
|
||||
swap >>close-hook
|
||||
add-toolbar
|
||||
<source-editor> >>text
|
||||
dup text>> margins <scroller> 1 track-add
|
||||
dup revert white-interior ;
|
||||
dup text>> margins <scroller> white-interior 1 track-add
|
||||
dup revert ;
|
||||
|
||||
M: slot-editor pref-dim* call-next-method { 600 200 } vmin ;
|
||||
|
||||
|
|
@ -75,3 +76,12 @@ slot-editor "toolbar" f {
|
|||
{ f delete }
|
||||
{ T{ key-down f f "ESC" } close }
|
||||
} define-command-map
|
||||
|
||||
: slot-editor-window ( close-hook update-hook assoc key key-string -- )
|
||||
[ <value-ref> <slot-editor> ]
|
||||
[
|
||||
<world-attributes>
|
||||
swap "Slot editor: " prepend >>title
|
||||
[ { dialog-window } append ] change-window-controls
|
||||
] bi*
|
||||
open-status-window ;
|
||||
|
|
@ -150,13 +150,13 @@ GENERIC#: accept-completion-hook 1 ( item popup -- )
|
|||
dup '[ _ accept-completion ] >>action ;
|
||||
|
||||
: <completion-scroller> ( completion-popup -- scroller )
|
||||
table>> <scroller> content-background <solid> >>interior ;
|
||||
table>> <scroller> white-interior ;
|
||||
|
||||
: <completion-popup> ( interactor completion-mode -- popup )
|
||||
[ vertical completion-popup new-track ] 2dip
|
||||
[ [ >>interactor ] [ >>completion-mode ] bi* ] [ <completion-table> >>table ] 2bi
|
||||
dup [ <completion-scroller> ] [ completion-mode>> completion-banner ] bi
|
||||
completion-color <framed-labeled> 1 track-add ;
|
||||
completion-color <framed-labeled-gadget> 1 track-add ;
|
||||
|
||||
completion-popup H{
|
||||
{ T{ key-down f f "TAB" } [ table>> row-action ] }
|
||||
|
|
|
|||
|
|
@ -1,17 +1,18 @@
|
|||
! Copyright (C) 2005, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs calendar combinators
|
||||
combinators.short-circuit concurrency.flags concurrency.mailboxes
|
||||
continuations destructors documents documents.elements fonts fry
|
||||
hashtables help help.markup help.tips io io.styles kernel lexer
|
||||
listener literals locals math math.vectors models models.arrow
|
||||
models.delay namespaces parser prettyprint sequences
|
||||
source-files.errors strings system threads tools.errors.model ui
|
||||
ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.glass
|
||||
ui.gadgets.labeled ui.gadgets.panes ui.gadgets.scrollers
|
||||
ui.gadgets.status-bar ui.gadgets.toolbar ui.gadgets.tracks ui.gestures
|
||||
ui.operations ui.pens.solid ui.theme ui.tools.browser ui.tools.common
|
||||
ui.tools.debugger ui.tools.error-list ui.tools.listener.completion
|
||||
combinators.short-circuit concurrency.flags
|
||||
concurrency.mailboxes continuations destructors documents
|
||||
documents.elements fonts fry hashtables help help.markup
|
||||
help.tips io io.styles kernel lexer listener literals locals
|
||||
math math.vectors models models.arrow models.delay namespaces
|
||||
parser prettyprint sequences source-files.errors strings system
|
||||
threads ui ui.commands ui.gadgets ui.gadgets.editors
|
||||
ui.gadgets.glass ui.gadgets.labeled ui.gadgets.panes
|
||||
ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.toolbar
|
||||
ui.gadgets.tracks ui.gestures ui.operations ui.pens.solid
|
||||
ui.theme ui.tools.browser ui.tools.common ui.tools.debugger
|
||||
ui.tools.error-list ui.tools.listener.completion
|
||||
ui.tools.listener.history ui.tools.listener.popups vocabs
|
||||
vocabs.loader vocabs.parser vocabs.refresh words ;
|
||||
IN: ui.tools.listener
|
||||
|
|
@ -347,7 +348,7 @@ M: object accept-completion-hook 2drop ;
|
|||
] ;
|
||||
|
||||
: frame-debugger ( debugger -- labeled )
|
||||
"Error" debugger-color <framed-labeled> ;
|
||||
"Error" debugger-color <framed-labeled-gadget> ;
|
||||
|
||||
:: <debugger-popup> ( error continuation interactor -- popup )
|
||||
error
|
||||
|
|
@ -485,8 +486,9 @@ PRIVATE>
|
|||
family size make-font-style
|
||||
inter output>> make-span-stream :> ostream
|
||||
ostream inter output<<
|
||||
inter font>> clone
|
||||
inter [
|
||||
clone
|
||||
family >>name
|
||||
size >>size
|
||||
inter font<<
|
||||
] change-font f >>line-height drop
|
||||
ostream output-stream set ;
|
||||
|
|
|
|||
|
|
@ -33,12 +33,12 @@ M: stack-entry-renderer row-value drop object>> ;
|
|||
|
||||
: <stack-display> ( model quot title color -- gadget )
|
||||
[ '[ dup _ when ] <arrow> <stack-table> margins <scroller> white-interior ] 2dip
|
||||
<labeled> ;
|
||||
<labeled-gadget> ;
|
||||
|
||||
: <callstack-display> ( model -- gadget )
|
||||
[ [ call>> callstack. ] when* ]
|
||||
<pane-control> t >>scrolls? margins <scroller> white-interior
|
||||
"Call stack" call-stack-color <labeled> ;
|
||||
"Call stack" call-stack-color <labeled-gadget> ;
|
||||
|
||||
: <datastack-display> ( model -- gadget )
|
||||
[ data>> ] "Data stack" data-stack-color <stack-display> ;
|
||||
|
|
|
|||
|
|
@ -1,19 +1,17 @@
|
|||
USING: accessors ui.gadgets ui.gadgets.labels namespaces make
|
||||
sequences kernel math arrays tools.test io ui.gadgets.panes
|
||||
ui.traverse definitions compiler.units ;
|
||||
USING: accessors arrays compiler.units definitions kernel make
|
||||
sequences tools.test ui.traverse ;
|
||||
IN: ui.traverse.tests
|
||||
|
||||
M: array children>> ;
|
||||
|
||||
GENERIC: (flatten-tree) ( node -- )
|
||||
GENERIC: flatten-tree% ( node -- )
|
||||
|
||||
M: node (flatten-tree)
|
||||
children>> [ (flatten-tree) ] each ;
|
||||
M: node flatten-tree% children>> [ flatten-tree% ] each ;
|
||||
|
||||
M: object (flatten-tree) , ;
|
||||
M: object flatten-tree% , ;
|
||||
|
||||
: flatten-tree ( seq -- newseq )
|
||||
[ [ (flatten-tree) ] each ] { } make ;
|
||||
[ [ flatten-tree% ] each ] { } make ;
|
||||
|
||||
: gadgets-in-range ( frompath topath gadget -- seq )
|
||||
gadget-subtree flatten-tree ;
|
||||
|
|
|
|||
|
|
@ -1,73 +1,59 @@
|
|||
! Copyright (C) 2007, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors namespaces make sequences kernel math arrays io
|
||||
ui.gadgets generic combinators fry sets ;
|
||||
USING: accessors arrays combinators fry generic io kernel locals
|
||||
make math namespaces sequences sets ui.gadgets ;
|
||||
IN: ui.traverse
|
||||
|
||||
TUPLE: node value children ;
|
||||
|
||||
: traverse-step ( path gadget -- path' gadget' )
|
||||
[ unclip ] dip children>> ?nth ;
|
||||
[ unclip-slice ] dip children>> ?nth ;
|
||||
|
||||
: make-node ( quot -- ) { } make node boa , ; inline
|
||||
: make-node ( value quot -- node ) { } make node boa ; inline
|
||||
|
||||
: traverse-to-path ( topath gadget -- )
|
||||
dup not [
|
||||
2drop
|
||||
] [
|
||||
over empty? [
|
||||
nip ,
|
||||
] [
|
||||
:: traverse-to-path ( topath gadget -- )
|
||||
gadget [
|
||||
topath empty? [
|
||||
[
|
||||
[ children>> swap first head-slice % ]
|
||||
[ nip ]
|
||||
[ traverse-step traverse-to-path ]
|
||||
2tri
|
||||
gadget children>> topath first head-slice %
|
||||
topath gadget traverse-step traverse-to-path
|
||||
] make-node
|
||||
] if
|
||||
] if ;
|
||||
] unless ,
|
||||
] when* ;
|
||||
|
||||
: traverse-from-path ( frompath gadget -- )
|
||||
dup not [
|
||||
2drop
|
||||
] [
|
||||
over empty? [
|
||||
nip ,
|
||||
] [
|
||||
:: traverse-from-path ( frompath gadget -- )
|
||||
gadget [
|
||||
frompath empty? [
|
||||
[
|
||||
[ traverse-step traverse-from-path ]
|
||||
[ nip ]
|
||||
[ children>> swap first 1 + tail-slice % ]
|
||||
2tri
|
||||
frompath gadget traverse-step traverse-from-path
|
||||
gadget children>> frompath first 1 + tail-slice %
|
||||
] make-node
|
||||
] if
|
||||
] if ;
|
||||
] unless ,
|
||||
] when* ;
|
||||
|
||||
: traverse-pre ( frompath gadget -- )
|
||||
traverse-step traverse-from-path ;
|
||||
|
||||
: (traverse-middle) ( frompath topath gadget -- )
|
||||
[ first 1 + ] [ first ] [ children>> ] tri* <slice> % ;
|
||||
|
||||
: traverse-post ( topath gadget -- )
|
||||
traverse-step traverse-to-path ;
|
||||
|
||||
: traverse-middle ( frompath topath gadget -- )
|
||||
[
|
||||
3dup nip traverse-pre
|
||||
3dup (traverse-middle)
|
||||
2dup traverse-post
|
||||
2nip
|
||||
] make-node ;
|
||||
:: traverse-middle ( frompath topath gadget -- )
|
||||
gadget [
|
||||
frompath gadget traverse-pre
|
||||
frompath first 1 + topath first gadget children>> <slice> %
|
||||
topath gadget traverse-post
|
||||
] make-node , ;
|
||||
|
||||
DEFER: (gadget-subtree)
|
||||
DEFER: gadget-subtree%
|
||||
|
||||
: traverse-child ( frompath topath gadget -- )
|
||||
[ 2nip ] 3keep
|
||||
[ [ rest-slice ] 2dip traverse-step (gadget-subtree) ]
|
||||
make-node ;
|
||||
:: traverse-child ( frompath topath gadget -- )
|
||||
gadget [
|
||||
frompath rest-slice
|
||||
topath gadget traverse-step
|
||||
gadget-subtree%
|
||||
] make-node , ;
|
||||
|
||||
: (gadget-subtree) ( frompath topath gadget -- )
|
||||
: gadget-subtree% ( frompath topath gadget -- )
|
||||
{
|
||||
{ [ dup not ] [ 3drop ] }
|
||||
{ [ pick empty? pick empty? and ] [ 2nip , ] }
|
||||
|
|
@ -78,7 +64,7 @@ DEFER: (gadget-subtree)
|
|||
} cond ;
|
||||
|
||||
: gadget-subtree ( frompath topath gadget -- seq )
|
||||
[ (gadget-subtree) ] { } make ;
|
||||
[ gadget-subtree% ] { } make ;
|
||||
|
||||
M: node gadget-text*
|
||||
[ children>> ] [ value>> ] bi gadget-seq-text ;
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@ TYPEDEF: GUID IID
|
|||
TYPEDEF: GUID CLSID
|
||||
|
||||
TYPEDEF: REFGUID LPGUID
|
||||
TYPEDEF: REFGUID LPCGUID
|
||||
TYPEDEF: REFGUID REFIID
|
||||
TYPEDEF: REFGUID REFCLSID
|
||||
|
||||
|
|
|
|||
|
|
@ -1,8 +1,9 @@
|
|||
! Copyright (C) 2005, 2006 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types alien.syntax parser namespaces
|
||||
kernel math windows.types generalizations math.bitwise
|
||||
classes.struct literals windows.kernel32 system accessors ;
|
||||
USING: accessors alien alien.c-types alien.syntax classes.struct
|
||||
generalizations kernel literals math math.bitwise namespaces
|
||||
parser system windows.com.syntax windows.kernel32 windows.ole32
|
||||
windows.types ;
|
||||
IN: windows.user32
|
||||
|
||||
! HKL for ActivateKeyboardLayout
|
||||
|
|
@ -1880,5 +1881,69 @@ FUNCTION: BOOL UpdateWindow ( HWND hWnd )
|
|||
! FUNCTION: wvsprintfA
|
||||
! FUNCTION: wvsprintfW
|
||||
|
||||
TYPEDEF: HANDLE HPOWERNOTIFY
|
||||
|
||||
FUNCTION: HPOWERNOTIFY RegisterPowerSettingNotification ( HANDLE hRecipient, LPCGUID PowerSettingGuid, DWORD Flags )
|
||||
FUNCTION: BOOL UnregisterPowerSettingNotification ( HPOWERNOTIFY Handle )
|
||||
|
||||
CONSTANT: GUID_ACDC_POWER_SOURCE
|
||||
GUID: {5d3e9a59-e9D5-4b00-a6bd-ff34ff516548}
|
||||
|
||||
CONSTANT: GUID_BATTERY_PERCENTAGE_REMAINING
|
||||
GUID: {a7ad8041-b45a-4cae-87a3-eecbb468a9e1}
|
||||
|
||||
CONSTANT: GUID_CONSOLE_DISPLAY_STATE
|
||||
GUID: {6fe69556-704a-47a0-8f24-c28d936fda47}
|
||||
|
||||
CONSTANT: GUID_GLOBAL_USER_PRESENCE
|
||||
GUID: {786e8a1d-b427-4344-9207-09e70bdcbea9}
|
||||
|
||||
CONSTANT: GUID_IDLE_BACKGROUND_TASK
|
||||
GUID: {515c31d8-f734-163d-a0fd-11a0-8c91e8f1}
|
||||
|
||||
CONSTANT: GUID_MONITOR_POWER_ON
|
||||
GUID: {02731015-4510-4526-99e6-e5a17ebd1aea}
|
||||
|
||||
CONSTANT: GUID_POWER_SAVING_STATUS
|
||||
GUID: {e00958c0-c213-4ace-ac77-fecced2eeea5}
|
||||
|
||||
CONSTANT: GUID_POWERSCHEME_PERSONALITY
|
||||
GUID: {245d8541-3943-4422-b025-13a7-84f679b7}
|
||||
|
||||
CONSTANT: GUID_MIN_POWER_SAVINGS
|
||||
GUID: {8c5e7fda-e8bf-4a96-9a85-a6e23a8c635c}
|
||||
|
||||
CONSTANT: GUID_MAX_POWER_SAVINGS
|
||||
GUID: {a1841308-3541-4fab-bc81-f71556f20b4a}
|
||||
|
||||
CONSTANT: GUID_TYPICAL_POWER_SAVINGS
|
||||
GUID: {381b4222-f694-41f0-9685-ff5bb260df2e}
|
||||
|
||||
CONSTANT: GUID_SESSION_DISPLAY_STATUS
|
||||
GUID: {2b84c20e-ad23-4ddf-93db-05ffbd7efca5}
|
||||
|
||||
CONSTANT: GUID_SESSION_USER_PRESENCE
|
||||
GUID: {3c0f4548-c03f-4c4d-b9f2-237ede686376}
|
||||
|
||||
CONSTANT: GUID_SYSTEM_AWAYMODE
|
||||
GUID: {98a7f580-01f7-48aa-9c0f-44352c29e5C0}
|
||||
|
||||
! This notification fires when the Lid Close Action is
|
||||
! changed by user in the Power Manager (Control Panel).
|
||||
CONSTANT: GUID_LIDCLOSE_ACTION
|
||||
GUID: {5ca83367-6e45-459f-a27b-476b1d01c936}
|
||||
|
||||
! This notifies when the laptop lid is physically opened or closed.
|
||||
CONSTANT: GUID_LIDSWITCH_STATE_CHANGE
|
||||
GUID: {ba3e0f4d-b817-4094-a2d1-d56379e6a0f3}
|
||||
|
||||
CONSTANT: PBT_POWERSETTINGCHANGE 0x8013
|
||||
|
||||
STRUCT: POWERBROADCAST_SETTING
|
||||
{ PowerSetting GUID }
|
||||
{ DataLength DWORD }
|
||||
{ Data UCHAR }
|
||||
;
|
||||
|
||||
: msgbox ( str -- )
|
||||
f swap "DebugMsg" MB_OK MessageBox drop ;
|
||||
|
|
|
|||
|
|
@ -388,14 +388,14 @@ PRIVATE>
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: (setup-each) ( seq -- n quot )
|
||||
: setup-each ( seq -- n quot )
|
||||
[ length check-length ] keep [ nth-unsafe ] curry ; inline
|
||||
|
||||
: setup-each ( seq quot -- n quot' )
|
||||
[ (setup-each) ] dip compose ; inline
|
||||
: (each) ( seq quot -- n quot' )
|
||||
[ setup-each ] dip compose ; inline
|
||||
|
||||
: (each-index) ( seq quot -- n quot' )
|
||||
[ (setup-each) [ keep ] curry ] dip compose ; inline
|
||||
[ setup-each [ keep ] curry ] dip compose ; inline
|
||||
|
||||
: (collect) ( quot into -- quot' )
|
||||
[ [ keep ] dip set-nth-unsafe ] 2curry ; inline
|
||||
|
|
@ -404,7 +404,7 @@ PRIVATE>
|
|||
(collect) each-integer ; inline
|
||||
|
||||
: map-into ( seq quot into -- )
|
||||
[ setup-each ] dip collect ; inline
|
||||
[ (each) ] dip collect ; inline
|
||||
|
||||
: 2nth-unsafe ( n seq1 seq2 -- elt1 elt2 )
|
||||
[ nth-unsafe ] bi-curry@ bi ; inline
|
||||
|
|
@ -418,17 +418,18 @@ PRIVATE>
|
|||
: 3nth-unsafe ( n seq1 seq2 seq3 -- elt1 elt2 elt3 )
|
||||
[ nth-unsafe ] tri-curry@ tri ; inline
|
||||
|
||||
: (3each) ( seq1 seq2 seq3 quot -- n quot' )
|
||||
[
|
||||
: setup-3each ( seq1 seq2 seq3 -- n quot )
|
||||
[ [ length ] tri@ min min check-length ]
|
||||
[ [ 3nth-unsafe ] 3curry ] 3bi
|
||||
] dip compose ; inline
|
||||
[ [ 3nth-unsafe ] 3curry ] 3bi ; inline
|
||||
|
||||
: (3each) ( seq1 seq2 seq3 quot -- n quot' )
|
||||
[ setup-3each ] dip compose ; inline
|
||||
|
||||
: finish-find ( i seq -- i elt )
|
||||
over [ dupd nth-unsafe ] [ drop f ] if ; inline
|
||||
|
||||
: (find) ( seq quot quot' -- i elt )
|
||||
pick [ [ setup-each ] dip call ] dip finish-find ; inline
|
||||
pick [ [ (each) ] dip call ] dip finish-find ; inline
|
||||
|
||||
: (find-from) ( n seq quot quot' -- i elt )
|
||||
[ 2dup bounds-check? ] 2dip
|
||||
|
|
@ -454,10 +455,10 @@ PRIVATE>
|
|||
PRIVATE>
|
||||
|
||||
: each ( ... seq quot: ( ... x -- ... ) -- ... )
|
||||
setup-each each-integer ; inline
|
||||
(each) each-integer ; inline
|
||||
|
||||
: each-from ( ... seq quot: ( ... x -- ... ) i -- ... )
|
||||
-rot setup-each (each-integer) ; inline
|
||||
-rot (each) (each-integer) ; inline
|
||||
|
||||
: reduce ( ... seq identity quot: ( ... prev elt -- ... next ) -- ... result )
|
||||
swapd each ; inline
|
||||
|
|
@ -466,7 +467,7 @@ PRIVATE>
|
|||
[ over ] dip [ [ collect ] keep ] new-like ; inline
|
||||
|
||||
: map-as ( ... seq quot: ( ... elt -- ... newelt ) exemplar -- ... newseq )
|
||||
[ setup-each ] dip map-integers ; inline
|
||||
[ (each) ] dip map-integers ; inline
|
||||
|
||||
: map ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq )
|
||||
over map-as ; inline
|
||||
|
|
@ -544,7 +545,7 @@ PRIVATE>
|
|||
[ find-integer ] (find-index) ; inline
|
||||
|
||||
: all? ( ... seq quot: ( ... elt -- ... ? ) -- ... ? )
|
||||
setup-each all-integers? ; inline
|
||||
(each) all-integers? ; inline
|
||||
|
||||
: push-if ( ..a elt quot: ( ..a elt -- ..b ? ) accum -- ..b )
|
||||
[ keep ] dip rot [ push ] [ 2drop ] if ; inline
|
||||
|
|
@ -1006,12 +1007,10 @@ PRIVATE>
|
|||
[ rest-slice ] [ first-unsafe ] bi ; inline
|
||||
|
||||
: map-reduce ( ..a seq map-quot: ( ..a elt -- ..b intermediate ) reduce-quot: ( ..b prev intermediate -- ..a next ) -- ..a result )
|
||||
[ [ dup first ] dip [ call ] keep ] dip compose
|
||||
swapd 1 each-from ; inline
|
||||
[ [ [ first ] keep ] dip [ dip ] keep ] dip compose 1 each-from ; inline
|
||||
|
||||
: 2map-reduce ( ..a seq1 seq2 map-quot: ( ..a elt1 elt2 -- ..b intermediate ) reduce-quot: ( ..b prev intermediate -- ..a next ) -- ..a result )
|
||||
[ [ 2dup [ first ] bi@ ] dip [ call ] keep ] dip compose
|
||||
[ -rot ] dip 1 2each-from ; inline
|
||||
[ [ [ [ first ] bi@ ] 2keep ] dip [ 2dip ] keep ] dip compose 1 2each-from ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
|
@ -1116,7 +1115,7 @@ PRIVATE>
|
|||
: generic-flip ( matrix -- newmatrix )
|
||||
[
|
||||
[ first-unsafe length 1 ] keep
|
||||
[ length min ] setup-each (each-integer) <iota>
|
||||
[ length min ] (each) (each-integer) <iota>
|
||||
] keep
|
||||
[ [ nth-unsafe ] with { } map-as ] curry { } map-as ; inline
|
||||
|
||||
|
|
@ -1129,7 +1128,7 @@ USE: arrays
|
|||
{ array } declare
|
||||
[
|
||||
[ first-unsafe array-length 1 ] keep
|
||||
[ array-length min ] setup-each (each-integer) <iota>
|
||||
[ array-length min ] (each) (each-integer) <iota>
|
||||
] keep
|
||||
[ [ { array } declare array-nth ] with { } map-as ] curry { } map-as ;
|
||||
|
||||
|
|
|
|||
|
|
@ -32,11 +32,11 @@ HELP: error-file
|
|||
{ $values { "error" "an error" } { "file" "a file path" } }
|
||||
{ $description "File in which the error occurred." } ;
|
||||
|
||||
HELP: <definition-error>
|
||||
HELP: new-source-file-error
|
||||
{ $values
|
||||
{ "error" "an error." }
|
||||
{ "definition" "an asset that contains the error." }
|
||||
{ "class" "a tuple class deriving source-file-error." }
|
||||
{ "error" "an error" }
|
||||
{ "asset" "an asset that contains the error" }
|
||||
{ "class" "a tuple class deriving source-file-error" }
|
||||
{ "source-file-error" source-file-error }
|
||||
}
|
||||
{ $description "Creates a new " { $link source-file-error } " instance." } ;
|
||||
|
|
|
|||
|
|
@ -19,6 +19,13 @@ M: source-file-error error-file [ error>> error-file ] [ path>> ] bi or ;
|
|||
M: source-file-error error-line [ error>> error-line ] [ line#>> ] bi or ;
|
||||
M: source-file-error compute-restarts error>> compute-restarts ;
|
||||
|
||||
: new-source-file-error ( error asset class -- source-file-error )
|
||||
new
|
||||
swap
|
||||
[ >>asset ]
|
||||
[ where [ first2 [ >>path ] [ >>line# ] bi* ] when* ] bi
|
||||
swap >>error ; inline
|
||||
|
||||
: sort-errors ( errors -- alist )
|
||||
[ [ line#>> 0 or ] sort-with ] { } assoc-map-as sort-keys ;
|
||||
|
||||
|
|
@ -29,13 +36,6 @@ TUPLE: error-type-holder type word plural icon quot forget-quot { fatal? initial
|
|||
|
||||
GENERIC: error-type ( error -- type )
|
||||
|
||||
: <definition-error> ( error definition class -- source-file-error )
|
||||
new
|
||||
swap
|
||||
[ >>asset ]
|
||||
[ where [ first2 [ >>path ] [ >>line# ] bi* ] when* ] bi
|
||||
swap >>error ; inline
|
||||
|
||||
SYMBOL: error-types
|
||||
|
||||
error-types [ V{ } clone ] initialize
|
||||
|
|
|
|||
|
|
@ -208,10 +208,10 @@ ERROR: shaped-bounds-error seq shape ;
|
|||
|
||||
! Inefficient
|
||||
: calculate-row-major-index ( seq shape -- i )
|
||||
1 [ * ] accumulate nip reverse v* sum ;
|
||||
1 [ * ] accumulate nip reverse v. ;
|
||||
|
||||
: calculate-column-major-index ( seq shape -- i )
|
||||
1 [ * ] accumulate nip v* sum ;
|
||||
1 [ * ] accumulate nip v. ;
|
||||
|
||||
: set-shaped-row-major ( obj seq shaped -- )
|
||||
shaped-bounds-check [ shape calculate-row-major-index ] [ underlying>> ] bi set-nth ;
|
||||
|
|
|
|||
|
|
@ -1,13 +1,13 @@
|
|||
! Copyright (C) 2008 Eduardo Cavazos.
|
||||
! Copyright (C) 2011 Anton Gorenko.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays boids.simulation calendar classes kernel
|
||||
literals locals math math.functions math.trig models opengl
|
||||
opengl.demo-support opengl.gl sequences threads ui ui.gadgets
|
||||
USING: accessors arrays boids.simulation calendar classes
|
||||
colors.constants combinators.smart.syntax kernel locals math
|
||||
math.functions math.trig models opengl opengl.gl
|
||||
processing.shapes sequences threads ui ui.gadgets
|
||||
ui.gadgets.borders ui.gadgets.buttons ui.gadgets.frames
|
||||
ui.gadgets.grids ui.gadgets.labeled ui.gadgets.labels
|
||||
ui.gadgets.packs ui.gadgets.sliders ui.render
|
||||
combinators.smart.syntax ;
|
||||
ui.gadgets.packs ui.gadgets.sliders ui.render ui.tools.common ;
|
||||
QUALIFIED-WITH: models.range mr
|
||||
IN: boids
|
||||
|
||||
|
|
@ -76,7 +76,7 @@ M: range-observer model-changed
|
|||
range-observer boa swap add-connection ;
|
||||
|
||||
:: behavior-panel ( behavior -- gadget )
|
||||
2 3 <frame> { 2 4 } >>gap { 0 0 } >>filled-cell
|
||||
2 3 <frame> white-interior { 2 4 } >>gap { 0 0 } >>filled-cell
|
||||
|
||||
"weight" <label> { 0 0 } grid-add
|
||||
behavior weight>> 100 * >fixnum 0 0 200 1 mr:<range>
|
||||
|
|
@ -93,7 +93,9 @@ M: range-observer model-changed
|
|||
dup [ deg>rad cos behavior angle-cos<< ] connect
|
||||
horizontal <slider> { 1 2 } grid-add
|
||||
|
||||
behavior class-of name>> <labeled-gadget> ;
|
||||
{ 5 5 } <border> white-interior
|
||||
|
||||
behavior class-of name>> color: gray <framed-labeled-gadget> ;
|
||||
|
||||
:: set-population ( n boids-gadget -- )
|
||||
boids-gadget [
|
||||
|
|
@ -110,9 +112,9 @@ M: range-observer model-changed
|
|||
[ length random-boids ] change-boids drop ;
|
||||
|
||||
:: simulation-panel ( boids-gadget -- gadget )
|
||||
<pile> { 2 2 } >>gap
|
||||
<pile> white-interior
|
||||
|
||||
2 2 <frame> { 4 4 } >>gap { 0 0 } >>filled-cell
|
||||
2 2 <frame> { 2 4 } >>gap { 0 0 } >>filled-cell
|
||||
|
||||
"population" <label> { 0 0 } grid-add
|
||||
initial-population 0 0 200 10 mr:<range>
|
||||
|
|
@ -124,7 +126,7 @@ M: range-observer model-changed
|
|||
dup [ boids-gadget dt<< ] connect
|
||||
horizontal <slider> { 1 1 } grid-add
|
||||
|
||||
add-gadget
|
||||
{ 5 5 } <border> add-gadget
|
||||
|
||||
<shelf> { 2 2 } >>gap
|
||||
"pause" [ drop boids-gadget pause-toggle ]
|
||||
|
|
@ -132,9 +134,9 @@ M: range-observer model-changed
|
|||
"randomize" [ drop boids-gadget randomize-boids ]
|
||||
<border-button> add-gadget
|
||||
|
||||
add-gadget
|
||||
{ 5 5 } <border> add-gadget
|
||||
|
||||
"simulation" <labeled-gadget> ;
|
||||
"simulation" color: gray <framed-labeled-gadget> ;
|
||||
|
||||
:: create-gadgets ( -- gadgets )
|
||||
<shelf>
|
||||
|
|
@ -142,7 +144,7 @@ M: range-observer model-changed
|
|||
boids-gadget [ start-boids-thread ] keep
|
||||
add-gadget
|
||||
|
||||
<pile> { 2 2 } >>gap 1.0 >>fill
|
||||
<pile> { 5 5 } >>gap 1.0 >>fill
|
||||
|
||||
boids-gadget simulation-panel
|
||||
add-gadget
|
||||
|
|
@ -150,8 +152,7 @@ M: range-observer model-changed
|
|||
boids-gadget behaviours>>
|
||||
[ behavior-panel add-gadget ] each
|
||||
|
||||
add-gadget
|
||||
{ 2 2 } <border> ;
|
||||
{ 5 5 } <border> add-gadget ;
|
||||
|
||||
MAIN-WINDOW: boids { { title "Boids" } }
|
||||
create-gadgets
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: accessors colors.constants colors.hex combinators
|
||||
combinators.smart formatting kernel literals models
|
||||
sorting.human sorting.slots strings ui ui.gadgets.scrollers
|
||||
ui.gadgets.tables ;
|
||||
ui.gadgets.search-tables ui.gadgets.tables ;
|
||||
IN: color-table
|
||||
|
||||
! ui.gadgets.tables demo
|
||||
|
|
@ -41,11 +41,11 @@ M: color-renderer row-value
|
|||
: <color-table> ( -- table )
|
||||
named-colors { human<=> } sort-by <model>
|
||||
color-renderer
|
||||
<table>
|
||||
[ ] <search-table> dup table>>
|
||||
5 >>gap
|
||||
color: dark-gray >>column-line-color
|
||||
10 >>min-rows
|
||||
10 >>max-rows ;
|
||||
10 >>max-rows drop ;
|
||||
|
||||
MAIN-WINDOW: color-table-demo { { title "Colors" } { pref-dim { 500 300 } } }
|
||||
<color-table> <scroller> >>gadgets ;
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: help.markup help.syntax sequences strings cpu.8080.emulator ;
|
|||
IN: cpu.8080
|
||||
|
||||
|
||||
ARTICLE: { "cpu-8080" "cpu-8080" } "Intel 8080 CPU Emulator"
|
||||
ARTICLE: "cpu.8080" "Intel 8080 CPU Emulator"
|
||||
"The cpu-8080 library provides an emulator for the Intel 8080 CPU"
|
||||
" instruction set. It is complete enough to emulate some 8080"
|
||||
" based arcade games." $nl
|
||||
|
|
@ -13,4 +13,4 @@ ARTICLE: { "cpu-8080" "cpu-8080" } "Intel 8080 CPU Emulator"
|
|||
"the " { $link rom-root } " variable to be set to the path "
|
||||
"containing the ROM file's." ;
|
||||
|
||||
ABOUT: { "cpu-8080" "cpu-8080" }
|
||||
ABOUT: "cpu.8080"
|
||||
|
|
|
|||
|
|
@ -65,7 +65,7 @@ sharp-continue ;
|
|||
|
||||
:: project-pt-line ( p p0 p1 -- q )
|
||||
p1 p0 v- :> vt
|
||||
p p0 v- vt v* sum
|
||||
p p0 v- vt v.
|
||||
vt norm-sq /
|
||||
vt n*v p0 v+ ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -191,7 +191,7 @@ GML: aNormal ( x -- y )
|
|||
} cond ;
|
||||
|
||||
: det2 ( x y -- z )
|
||||
{ 1 0 } vshuffle double-2{ 1 -1 } v* v* sum ; inline
|
||||
{ 1 0 } vshuffle double-2{ 1 -1 } v* v. ; inline
|
||||
|
||||
: det3 ( x y z -- w )
|
||||
[ cross ] dip v. ; inline
|
||||
|
|
|
|||
|
|
@ -1,11 +1,12 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
USING: arrays accessors euler.b-rep fry gml gml.runtime gml.viewer
|
||||
gml.printer io.directories io.encodings.utf8 io.files
|
||||
io.pathnames io.streams.string kernel locals models namespaces
|
||||
sequences ui ui.gadgets ui.gadgets.buttons ui.gadgets.editors
|
||||
ui.gadgets.frames ui.gadgets.grids ui.gadgets.labels
|
||||
ui.gadgets.packs ui.gadgets.scrollers ui.gadgets.worlds
|
||||
ui.gadgets.tables ui.gadgets.labeled unicode ;
|
||||
USING: arrays accessors colors.constants euler.b-rep fry gml
|
||||
gml.runtime gml.viewer gml.printer io.directories
|
||||
io.encodings.utf8 io.files io.pathnames io.streams.string kernel
|
||||
locals models namespaces sequences ui ui.gadgets
|
||||
ui.gadgets.buttons ui.gadgets.editors ui.gadgets.frames
|
||||
ui.gadgets.grids ui.gadgets.labels ui.gadgets.packs
|
||||
ui.gadgets.scrollers ui.gadgets.worlds ui.gadgets.tables
|
||||
ui.gadgets.labeled unicode ;
|
||||
FROM: gml => gml ;
|
||||
IN: gml.ui
|
||||
|
||||
|
|
@ -25,7 +26,8 @@ M: stack-entry-renderer row-value
|
|||
40 >>max-cols ;
|
||||
|
||||
: <stack-display> ( model -- gadget )
|
||||
<stack-table> <scroller> "Operand stack" <labeled-gadget> ;
|
||||
<stack-table> <scroller> "Operand stack"
|
||||
COLOR: dark-gray <labeled-gadget> ;
|
||||
|
||||
TUPLE: gml-editor < frame editor gml stack-model b-rep b-rep-model ;
|
||||
|
||||
|
|
@ -97,7 +99,7 @@ CONSTANT: example-dir "vocab:gml/examples/"
|
|||
30 >>max-rows
|
||||
40 >>min-cols
|
||||
40 >>max-cols
|
||||
<scroller> "Editor" <labeled-gadget> ;
|
||||
<scroller> "Editor" COLOR: dark-gray <labeled-gadget> ;
|
||||
|
||||
: <gml-editor> ( -- gadget )
|
||||
2 3 gml-editor new-frame
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ HELP: encode-test
|
|||
{ $values
|
||||
{ "path" "a pathname string" } { "image-class" object }
|
||||
}
|
||||
{ $description "Runs a unit-test on the image at " { $snippet "path" } " to test the image encoder. The image is decoded, encoded, and then decoded again to verify that the final decoded output matches the original decoded output. Before comparison for equality, the images are normalized in order to accomodate differences in representation between the two potential encoders." }
|
||||
{ $description "Runs a unit-test on the image at " { $snippet "path" } " to test the image encoder. The image is decoded, encoded, and then decoded again to verify that the final decoded output matches the original decoded output. Before comparison for equality, the images are normalized in order to accommodate differences in representation between the two potential encoders." }
|
||||
{ $warning "This test assumes that the image decoder is working correctly. If the image fails both the " { $link decode-test } " and the " { $link encode-test } ", then you should first debug the decoder. Once the decoder is working correctly, proceed with testing the encoder." } ;
|
||||
|
||||
HELP: images.
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors calendar.format calendar.model fonts fry
|
||||
grouping kernel math models.arrow namespaces sequences ui
|
||||
USING: accessors calendar calendar.format fonts fry grouping
|
||||
kernel math sequences timers threads ui ui.gadgets
|
||||
ui.gadgets.labels ;
|
||||
IN: lcd
|
||||
|
||||
|
|
@ -19,10 +19,19 @@ IN: lcd
|
|||
: lcd ( digit-str -- string )
|
||||
4 <iota> [ lcd-row ] with map "\n" join ;
|
||||
|
||||
: <time-display> ( model -- gadget )
|
||||
[ timestamp>hms lcd ] <arrow> <label-control>
|
||||
"99:99:99" lcd >>string
|
||||
monospace-font >>font ;
|
||||
TUPLE: time-display < label timer ;
|
||||
|
||||
: <time-display> ( -- gadget )
|
||||
"99:99:99" lcd time-display new-label
|
||||
monospace-font >>font
|
||||
dup '[ now timestamp>hms lcd _ string<< ]
|
||||
f 1 seconds <timer> >>timer ;
|
||||
|
||||
M: time-display graft*
|
||||
[ timer>> start-timer yield ] [ call-next-method ] bi ;
|
||||
|
||||
M: time-display ungraft*
|
||||
[ timer>> stop-timer ] [ call-next-method ] bi ;
|
||||
|
||||
MAIN-WINDOW: time-window { { title "Time" } }
|
||||
time get <time-display> >>gadgets ;
|
||||
<time-display> >>gadgets ;
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2012 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: kernel math math.functions math.statistics math.vectors
|
||||
sequences sequences.extras ;
|
||||
USING: kernel math math.functions math.similarity
|
||||
math.statistics math.vectors sequences sequences.extras ;
|
||||
|
||||
IN: math.distances
|
||||
|
||||
|
|
@ -22,7 +22,7 @@ IN: math.distances
|
|||
v- vabs supremum ;
|
||||
|
||||
: cosine-distance ( a b -- n )
|
||||
[ v* sum ] [ [ norm ] bi@ * ] 2bi / 1 swap - ;
|
||||
cosine-similarity 1 swap - ;
|
||||
|
||||
: canberra-distance ( a b -- n )
|
||||
[ v- vabs ] [ [ vabs ] bi@ v+ ] 2bi v/ sum ;
|
||||
|
|
@ -31,4 +31,4 @@ IN: math.distances
|
|||
[ v- ] [ v+ ] 2bi [ vabs sum ] bi@ / ;
|
||||
|
||||
: correlation-distance ( a b -- n )
|
||||
[ demean ] bi@ [ v* sum ] [ [ norm ] bi@ * ] 2bi / 1 swap - ;
|
||||
[ demean ] bi@ cosine-distance ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2012 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: math.functions math.similarity tools.test ;
|
||||
USING: math.functions math.similarity math.vectors tools.test ;
|
||||
|
||||
IN: math.similarity.tests
|
||||
|
||||
|
|
@ -12,7 +12,16 @@ CONSTANT: b { 0 0 0 0 2 3 1 }
|
|||
{ t } [ a b euclidian-similarity 0.1336766024001917 1e-10 ~ ] unit-test
|
||||
|
||||
{ t } [ a a pearson-similarity 1.0 1e-10 ~ ] unit-test
|
||||
{ t } [ a a vneg pearson-similarity 0.0 1e-10 ~ ] unit-test
|
||||
{ t } [ a b pearson-similarity 0.2376861940759582 1e-10 ~ ] unit-test
|
||||
|
||||
{ t } [ a a cosine-similarity 1.0 1e-10 ~ ] unit-test
|
||||
{ t } [ a b cosine-similarity 0.5472455591261534 1e-10 ~ ] unit-test
|
||||
{ t } [ a a vneg cosine-similarity -1.0 1e-10 ~ ] unit-test
|
||||
{ t } [ a b cosine-similarity 0.0944911182523068 1e-10 ~ ] unit-test
|
||||
|
||||
|
||||
{ 3/100 } [
|
||||
{ 0 0 0 10 10 } { 0 0 1 1 1 } { 0 0 0 1 2 }
|
||||
weighted-cosine-similarity
|
||||
] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2012 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: kernel math math.statistics math.vectors sequences sets ;
|
||||
USING: kernel math math.functions math.statistics math.vectors
|
||||
sequences sequences.extras ;
|
||||
|
||||
IN: math.similarity
|
||||
|
||||
|
|
@ -18,3 +19,17 @@ IN: math.similarity
|
|||
[ intersect cardinality dup ]
|
||||
[ [ cardinality ] bi@ + swap - ] 2bi
|
||||
[ drop 0 ] [ /f ] if-zero ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: weighted-v. ( w a b -- n )
|
||||
[ * * ] [ + ] 3map-reduce ;
|
||||
|
||||
: weighted-norm ( w a -- n )
|
||||
[ absq * ] [ + ] 2map-reduce ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: weighted-cosine-similarity ( w a b -- n )
|
||||
[ weighted-v. ]
|
||||
[ [ over ] dip [ weighted-norm ] 2bi@ * ] 3bi / ;
|
||||
|
|
|
|||
|
|
@ -1,8 +1,7 @@
|
|||
USING: accessors arrays fry io.directories kernel
|
||||
models sequences sets ui
|
||||
ui.gadgets ui.gadgets.buttons ui.gadgets.labeled
|
||||
ui.gadgets.tracks ui.gadgets.labels ui.gadgets.glass
|
||||
math.rectangles cocoa.dialogs ;
|
||||
USING: accessors arrays colors.constants file-picker fry
|
||||
io.directories kernel math.rectangles models sequences sets ui
|
||||
ui.gadgets ui.gadgets.buttons ui.gadgets.glass
|
||||
ui.gadgets.labeled ui.gadgets.labels ui.gadgets.tracks ;
|
||||
IN: merger
|
||||
|
||||
MAIN-WINDOW: merger-window {
|
||||
|
|
@ -14,20 +13,26 @@ MAIN-WINDOW: merger-window {
|
|||
[
|
||||
[
|
||||
"…" [
|
||||
open-panel [ first
|
||||
open-file-dialog [
|
||||
first
|
||||
[ <label> 1array >>children drop ]
|
||||
[ swap set-control-value ] 2bi ] [ drop ] if*
|
||||
] <border-button> swap >>model swap <labeled-gadget>
|
||||
[ swap set-control-value ] 2bi
|
||||
] [ drop ] if*
|
||||
] <border-button> swap >>model swap
|
||||
COLOR: black <labeled-gadget>
|
||||
1 track-add
|
||||
] 2each
|
||||
] keep
|
||||
dup first2
|
||||
'[ _ [ value>> ] all? [ parent>> "processing..." <label> [
|
||||
'[
|
||||
_ [ value>> ] all? [
|
||||
parent>> "processing..." <label> [
|
||||
<zero-rect> show-glass
|
||||
_ value>> [
|
||||
"." _ value>> [ [ directory-files ] bi@ diff ] keep copy-files-into
|
||||
"." _ value>>
|
||||
[ [ directory-files ] bi@ diff ] keep copy-files-into
|
||||
] with-directory
|
||||
] keep hide-glass
|
||||
] [ drop ] if ]
|
||||
"merge" swap <border-button> 0.4 track-add
|
||||
] [ drop ] if
|
||||
] "merge" swap <border-button> 0.4 track-add
|
||||
>>gadgets ;
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
macosx
|
||||
|
|
@ -23,7 +23,7 @@ HELP: add-history
|
|||
{ $values { "history" history } }
|
||||
{ $description "Adds the current value to the history." } ;
|
||||
|
||||
ARTICLE: "models-history" "History models"
|
||||
ARTICLE: "models.history" "History models"
|
||||
"History models record previous values."
|
||||
{ $subsections
|
||||
history
|
||||
|
|
@ -37,4 +37,4 @@ ARTICLE: "models-history" "History models"
|
|||
go-forward
|
||||
} ;
|
||||
|
||||
ABOUT: "models-history"
|
||||
ABOUT: "models.history"
|
||||
|
|
|
|||
|
|
@ -39,10 +39,10 @@ HELP: version>=
|
|||
{ "?" boolean }
|
||||
} ;
|
||||
|
||||
ARTICLE: { "Versioning" "Semantic Versioning" } "Semantic Versioning"
|
||||
ARTICLE: "semantic-versioning" "Semantic Versioning"
|
||||
{ $vocab-link "semantic-versioning" }
|
||||
$nl
|
||||
{ "See " { $url "http://semver.org/" } " for a detailed description of semantic versioning." }
|
||||
;
|
||||
|
||||
ABOUT: { "Versioning" "Semantic Versioning" }
|
||||
ABOUT: "semantic-versioning"
|
||||
|
|
|
|||
|
|
@ -293,6 +293,14 @@ PRIVATE>
|
|||
: 2count ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... ? ) -- ... n )
|
||||
[ 1 0 ? ] compose 2map-sum ; inline
|
||||
|
||||
: 3each-from
|
||||
( ... seq1 seq2 seq3 quot: ( ... elt1 elt2 elt3 -- ... ) i -- ... )
|
||||
[ (3each) ] dip -rot (each-integer) ; inline
|
||||
|
||||
: 3map-reduce
|
||||
( ..a seq1 seq2 seq3 map-quot: ( ..a elt1 elt2 elt3 -- ..b intermediate ) reduce-quot: ( ..b prev intermediate -- ..a next ) -- ..a result )
|
||||
[ [ [ [ first ] tri@ ] 3keep ] dip [ 3dip ] keep ] dip compose 1 3each-from ; inline
|
||||
|
||||
: round-robin ( seq -- newseq )
|
||||
[ { } ] [
|
||||
[ longest length <iota> ] keep
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ CONSTANT: stylesheet
|
|||
}
|
||||
{ code-style
|
||||
H{
|
||||
{ page-color T{ rgba f 0.4 0.4 0.4 0.3 } }
|
||||
{ page-color T{ rgba f 0.9 0.9 0.9 1 } }
|
||||
}
|
||||
}
|
||||
{ snippet-style
|
||||
|
|
|
|||
|
|
@ -1,8 +1,7 @@
|
|||
USING: help.markup help.syntax ;
|
||||
IN: snake-game
|
||||
|
||||
ARTICLE: { "snake-game" "about" } "About Snake Game"
|
||||
{ $heading "About" }
|
||||
ARTICLE: "snake-game" "Snake Game"
|
||||
"A remake of the popular Snake game. To start the game:"
|
||||
{ $code "play-snake-game" }
|
||||
{ $heading "Keys" }
|
||||
|
|
@ -22,4 +21,4 @@ ARTICLE: { "snake-game" "about" } "About Snake Game"
|
|||
HELP: play-snake-game
|
||||
{ $description "Starts the game!" } ;
|
||||
|
||||
ABOUT: { "snake-game" "about" }
|
||||
ABOUT: "snake-game"
|
||||
|
|
|
|||
|
|
@ -147,7 +147,7 @@ CONSTANT: galois-slides
|
|||
"Very slow! Let's profile it..."
|
||||
}
|
||||
{ $slide "Example: memoization"
|
||||
{ "Let's use " { $link postpone: \: } " instead of " { $link postpone: \MEMO: } }
|
||||
{ "Let's use " { $link postpone: \MEMO: } " instead of " { $link postpone: \MEMO: } }
|
||||
{ $code
|
||||
"MEMO: fib ( m -- n )"
|
||||
" dup 1 > ["
|
||||
|
|
@ -172,8 +172,8 @@ CONSTANT: galois-slides
|
|||
{ { $link postpone: \EBNF: } ": a complex parsing word" }
|
||||
"Implements a custom syntax for expressing parsers: like OMeta!"
|
||||
{ "Example: " { $vocab-link "printf-example" } }
|
||||
{ $code "\"vegan\" \"cheese\" \"%s is not %s\\n\" printf" }
|
||||
{ $code "5 \"Factor\" \"%s is %d years old\\n\" printf" }
|
||||
{ $code "\"cheese\" \"vegan\" \"%s is not %s\\n\" printf" }
|
||||
{ $code "\"Factor\" 5 \"%s is %d years old\\n\" printf" }
|
||||
}
|
||||
{ $slide "Example: simple web browser"
|
||||
{ $vocab-link "webkit-demo" }
|
||||
|
|
@ -273,7 +273,7 @@ CONSTANT: galois-slides
|
|||
}
|
||||
{ $slide "Compiler: low-level optimizer"
|
||||
"Redundant stack operations eliminated, intermediate floats unboxed..."
|
||||
{ $code "[ c pixel ] test-mr mr." }
|
||||
{ $code "[ c pixel ] regs." }
|
||||
}
|
||||
{ $slide "Garbage collection"
|
||||
"All roots are identified precisely"
|
||||
|
|
|
|||
|
|
@ -335,8 +335,8 @@ CONSTANT: google-slides
|
|||
{ { $link postpone: \EBNF: } ": a complex parsing word" }
|
||||
"Implements a custom syntax for expressing parsers"
|
||||
{ "Example: " { $vocab-link "printf-example" } }
|
||||
{ $code "\"vegan\" \"cheese\" \"%s is not %s\\n\" printf" }
|
||||
{ $code "5 \"Factor\" \"%s is %d years old\\n\" printf" }
|
||||
{ $code "\"cheese\" \"vegan\" \"%s is not %s\\n\" printf" }
|
||||
{ $code "\"Factor\" 5 \"%s is %d years old\\n\" printf" }
|
||||
}
|
||||
{ $slide "Input/output library"
|
||||
"One of Factor's strongest points: portable, full-featured, efficient"
|
||||
|
|
@ -455,9 +455,9 @@ CONSTANT: google-slides
|
|||
{ $slide "Compiler: low level IR"
|
||||
"Register-based SSA"
|
||||
"Stack operations expand into low-level instructions"
|
||||
{ $code "[ 5 ] test-mr mr." }
|
||||
{ $code "[ swap ] test-mr mr." }
|
||||
{ $code "[ append reverse ] test-mr mr." }
|
||||
{ $code "[ 5 ] regs." }
|
||||
{ $code "[ swap ] regs." }
|
||||
{ $code "[ append reverse ] regs." }
|
||||
}
|
||||
{ $slide "Compiler: low-level optimizer"
|
||||
"5 optimization passes"
|
||||
|
|
@ -469,7 +469,7 @@ CONSTANT: google-slides
|
|||
{ "Example: " { $link 2array } }
|
||||
{ { $link <array> } " fills array with initial value" }
|
||||
"What if we immediately store new values into the array?"
|
||||
{ $code "\\ 2array test-mr mr." }
|
||||
{ $code "\\ 2array regs." }
|
||||
"Mandelbrot: we optimize stack operations"
|
||||
}
|
||||
{ $slide "Compiler: value numbering"
|
||||
|
|
@ -508,7 +508,7 @@ CONSTANT: google-slides
|
|||
"Simple IR rewrite step"
|
||||
"After register allocation, one vreg may have several live intervals, and different physical registers at different points in time"
|
||||
"Hence, \"second chance\""
|
||||
{ "Mandelbrot: " { $code "[ c pixel ] test-mr mr." } }
|
||||
{ "Mandelbrot: " { $code "[ c pixel ] regs." } }
|
||||
}
|
||||
{ $slide "Compiler: code generation"
|
||||
"Iterate over list of instructions"
|
||||
|
|
|
|||
|
|
@ -105,7 +105,7 @@ CONSTANT: minneapolis-slides
|
|||
}
|
||||
"It is slow:"
|
||||
{ $code
|
||||
"35 [ fib ] map ."
|
||||
"35 <iota> [ fib ] map ."
|
||||
}
|
||||
"Let's profile it!"
|
||||
}
|
||||
|
|
@ -126,7 +126,7 @@ CONSTANT: minneapolis-slides
|
|||
}
|
||||
"It is faster:"
|
||||
{ $code
|
||||
"35 [ fib ] map ."
|
||||
"35 <iota> [ fib ] map ."
|
||||
}
|
||||
}
|
||||
{ $slide "The Factor UI"
|
||||
|
|
|
|||
|
|
@ -66,7 +66,7 @@ CONSTANT: otug-slides
|
|||
{ $slide "Combinators"
|
||||
{ "A " { $emphasis "combinator" } " is a word taking quotations as input" }
|
||||
{ "Used for control flow, data flow, iteration" }
|
||||
{ $code "100 [ 5 mod 3 = [ \"Fizz!\" print ] when ] each" }
|
||||
{ $code "100 <iota> [ 5 mod 3 = [ \"Fizz!\" print ] when ] each" }
|
||||
{ "Control flow: " { $link if } ", " { $link when } ", " { $link unless } ", " { $link cond } }
|
||||
{ "Iteration: " { $link map } ", " { $link filter } ", " { $link all? } ", ..." }
|
||||
}
|
||||
|
|
@ -250,7 +250,7 @@ var price = (order == null ? null : order.price);" }
|
|||
1 >>fill
|
||||
\"Hello world!\" <label> add-gadget
|
||||
\"Click me!\" [ drop beep ]
|
||||
<bevel-button> add-gadget
|
||||
<border-button> add-gadget
|
||||
<editor> <scroller> add-gadget
|
||||
\"UI test\" open-window" }
|
||||
}
|
||||
|
|
|
|||
|
|
@ -333,7 +333,7 @@ var price = (order == null ? null : order.price);" }
|
|||
}
|
||||
{ $slide "Macro example"
|
||||
"Return the caaar of a sequence"
|
||||
{ "Return " { $snippet f } " on failure" }
|
||||
{ "Return " { $snippet "f" } " on failure" }
|
||||
{ $code ": caaar ( seq/f -- x/f )
|
||||
{
|
||||
[ first ]
|
||||
|
|
|
|||
|
|
@ -192,8 +192,8 @@ CONSTANT: vpri-slides
|
|||
{ { $link postpone: \EBNF: } ": a complex parsing word" }
|
||||
"Implements a custom syntax for expressing parsers: like OMeta!"
|
||||
{ "Example: " { $vocab-link "printf-example" } }
|
||||
{ $code "\"vegan\" \"cheese\" \"%s is not %s\\n\" printf" }
|
||||
{ $code "5 \"Factor\" \"%s is %d years old\\n\" printf" }
|
||||
{ $code "\"cheese\" \"vegan\" \"%s is not %s\\n\" printf" }
|
||||
{ $code "\"Factor\" 5 \"%s is %d years old\\n\" printf" }
|
||||
}
|
||||
{ $slide "Example: simple web browser"
|
||||
{ $vocab-link "webkit-demo" }
|
||||
|
|
@ -359,9 +359,9 @@ CONSTANT: vpri-slides
|
|||
{ $slide "Compiler: low level IR"
|
||||
"Register-based SSA"
|
||||
"Stack operations expand into low-level instructions"
|
||||
{ $code "[ 5 ] test-mr mr." }
|
||||
{ $code "[ swap ] test-mr mr." }
|
||||
{ $code "[ append reverse ] test-mr mr." }
|
||||
{ $code "[ 5 ] regs." }
|
||||
{ $code "[ swap ] regs." }
|
||||
{ $code "[ append reverse ] regs." }
|
||||
}
|
||||
{ $slide "Compiler: low-level optimizer"
|
||||
"5 optimization passes"
|
||||
|
|
@ -373,7 +373,7 @@ CONSTANT: vpri-slides
|
|||
{ "Example: " { $link 2array } }
|
||||
{ { $link <array> } " fills array with initial value" }
|
||||
"What if we immediately store new values into the array?"
|
||||
{ $code "\\ 2array test-mr mr." }
|
||||
{ $code "\\ 2array regs." }
|
||||
"Mandelbrot: we optimize stack operations"
|
||||
}
|
||||
{ $slide "Compiler: value numbering"
|
||||
|
|
@ -412,7 +412,7 @@ CONSTANT: vpri-slides
|
|||
"Simple IR rewrite step"
|
||||
"After register allocation, one vreg may have several live intervals, and different physical registers at different points in time"
|
||||
"Hence, \"second chance\""
|
||||
{ "Mandelbrot: " { $code "[ c pixel ] test-mr mr." } }
|
||||
{ "Mandelbrot: " { $code "[ c pixel ] regs." } }
|
||||
}
|
||||
{ $slide "Compiler: code generation"
|
||||
"Iterate over list of instructions"
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Pi
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
! Copyright (C) 2017 Pi.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax strings ;
|
||||
IN: unicode.control-pictures
|
||||
|
||||
HELP: control-pictures
|
||||
{ $values
|
||||
{ "string" string }
|
||||
}
|
||||
{ $description "Transforms C0 control characters into their corresponding Control Picture block codepoints." } ;
|
||||
|
||||
ARTICLE: "unicode.control-pictures" "Control Pictures"
|
||||
"The " { $vocab-link "unicode.control-pictures" } " vocabulary provides a utility word " { $link control-pictures } " for transforming characters in the nonprintable " { $url "http://www.unicode.org/charts/PDF/U0000.pdf" "ASCII C0 block" } " to their representations in the " { $url "http://www.unicode.org/charts/PDF/U2400.pdf" "Control Pictures" } " block. It has no effect on any other characters."
|
||||
;
|
||||
|
||||
ABOUT: "unicode.control-pictures"
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
USING: sequences strings tools.test unicode.control-pictures ;
|
||||
|
||||
{ "␀␁␂␃␄␅␆␇␈␉␊␋␌␍␎␏␐␑␒␓␔␕␖␗␘␙␚␛␜␝␞␟ !\"#$%&'()*+,-./" } [
|
||||
48 <iota> >string control-pictures
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
! Copyright (C) 2017 Pi.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators kernel math sequences ;
|
||||
IN: unicode.control-pictures
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: char>control-picture ( char -- char' )
|
||||
{
|
||||
{ [ dup 0x20 < ] [ 0x2400 bitor ] }
|
||||
{ [ dup 0x7f = ] [ drop 0x2421 ] }
|
||||
[ ]
|
||||
} cond ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: control-pictures ( string -- string )
|
||||
[ char>control-picture ] map ;
|
||||
Loading…
Reference in New Issue