inspector
Slava Pestov
parent
dc161369cc
commit
9df3845237
|
|
@ -6,10 +6,22 @@
|
|||
|
||||
+ ui:
|
||||
|
||||
- scrollable inspector
|
||||
- inspector needs prettier nesting
|
||||
- <titled> needs to look better
|
||||
- enforce inspector uniqueness
|
||||
- auto-updating inspector
|
||||
- fix up the min thumb size hack
|
||||
- fix up initial layout of slider
|
||||
- console: scroll to bottom
|
||||
- caret clip
|
||||
- split preferred size and layouting
|
||||
- remove shelf/pile duplication
|
||||
- menus
|
||||
- opaque widgets
|
||||
- layered gadget
|
||||
- resizing and moving gadgets interactively with halo on top of gadget
|
||||
- hand clip
|
||||
|
||||
+ compiler/ffi:
|
||||
|
||||
|
|
@ -36,8 +48,6 @@
|
|||
|
||||
+ i/o:
|
||||
|
||||
- udp
|
||||
- ipv6
|
||||
- stream server can hang because of exception handler limitations
|
||||
- better i/o scheduler
|
||||
- nicer way to combine two paths
|
||||
|
|
|
|||
|
|
@ -0,0 +1,84 @@
|
|||
Formal model of a mini-Factor.
|
||||
------------------------------
|
||||
|
||||
* Objects
|
||||
|
||||
OBJ is by definition the set of all possible objects.
|
||||
|
||||
OBJ contains objects of three distinct types:
|
||||
|
||||
- f
|
||||
|
||||
- [[ a b ]] where a and b are objects. Abbreviation: [ a b c ... ] for
|
||||
nested conses terminating with f.
|
||||
|
||||
- primitive words:
|
||||
call ?
|
||||
cons car cdr
|
||||
drop dup swap >r r>
|
||||
datastack set-datastack callstack set-callstack
|
||||
|
||||
* Arrows
|
||||
|
||||
ARROW is by definition the set of recursive (effectively computable)
|
||||
functions from OBJ to OBJ.
|
||||
|
||||
* The e function
|
||||
|
||||
Now consider a map e: OBJ * OBJ * OBJ --> OBJ.
|
||||
|
||||
The e function takes three objects (or really, a list of three elements,
|
||||
which is itself an object) and is defined recursively as follows:
|
||||
|
||||
(Here, uppercase words are variables, lowercase are symbols.)
|
||||
|
||||
** Base case; no more code to evaluate, return resulting datastack:
|
||||
|
||||
e[DS f f] = DS
|
||||
|
||||
** Recursive cases:
|
||||
|
||||
e[DS < Q CS > f] = e[DS CS Q]
|
||||
e[DS CS < X CF >] = e[< X DS > CS CF]
|
||||
|
||||
** Primitive words:
|
||||
|
||||
e[< Q DS > CS < call CF >] = e[DS < CF CS > Q]
|
||||
e[< F < T < f DS > > > CS < ? CF >] = e[< F DS > CS CF]
|
||||
e[< F < T < X DS > > > CS < ? CF >] = e[< T DS > CS CF]
|
||||
|
||||
e[< A D DS > CS < cons CF >] = e[< < A D > DS > CS CF]
|
||||
e[< < A D > DS > CS < car CF >] = e[< A DS > CS CF]
|
||||
e[< < A D > DS > CS < cdr CF >] = e[< D DS > CS CF]
|
||||
|
||||
e[< X DS > CS < drop CF >] = e[DS CS CF]
|
||||
e[< X DS > CS < dup CF >] = e[< X < X DS > > CS CF]
|
||||
e[< X < Y DS > > CS < swap CF >] = e[< Y < X DS > > CS CF]
|
||||
e[< X DS > CS < >r CF >] = e[DS < X CS > CF]
|
||||
e[DS < X CS > < r> CF >] = e[< X DS > CS CF]
|
||||
|
||||
e[DS CS < datastack CF >] = e[< DS DS > CS CF]
|
||||
e[< L DS > CS < set-datastack CF >] = e[L CS CF]
|
||||
e[DS CS < callstack CF >] = e[< CS DS > CS CF]
|
||||
e[< L DS > CS < set-callstack CF >] = e[DS L CF]
|
||||
|
||||
Define
|
||||
|
||||
eval Q = e[f,f,Q]
|
||||
|
||||
* A fixed-point combinator
|
||||
|
||||
[ dup cons over call ] dup cons over call
|
||||
|
||||
* Turing-completeness
|
||||
|
||||
First, I claim that e is recursive; so e is an element of ARROW.
|
||||
|
||||
Furthermore, for any element g in ARROW, there exists an element G in
|
||||
OBJ such that g(x) = eval < x G >. This means that the language executed
|
||||
by e is turing-complete, and that ARROW can be identified with a subset
|
||||
of OBJ.
|
||||
|
||||
Furthermore, there exists an element E in OBJ such that
|
||||
e(x) = eval < x E >; so we have proven that there exists a Factor
|
||||
interpreter written in Factor.
|
||||
|
|
@ -15,7 +15,7 @@
|
|||
! "examples/text-demo.factor" run-file
|
||||
|
||||
IN: text-demo
|
||||
USING: listener threads unparser ;
|
||||
USING: listener parser threads unparser ;
|
||||
USE: streams
|
||||
USE: sdl
|
||||
USE: sdl-event
|
||||
|
|
@ -66,9 +66,11 @@ USE: words
|
|||
! "Another field." <field> "pile" get add-gadget
|
||||
<console-pane> <scroller> "pile" get add-gadget
|
||||
|
||||
"pile" get bevel-border dup "dialog" set ! dup
|
||||
! moving-actions
|
||||
world get add-gadget ;
|
||||
"pile" get bevel-border dup "dialog" set dup
|
||||
moving-actions
|
||||
world get add-gadget
|
||||
|
||||
;
|
||||
|
||||
: gadget-demo ( -- )
|
||||
make-shapes
|
||||
|
|
|
|||
|
|
@ -56,7 +56,7 @@ IN: lists USING: kernel ;
|
|||
: zip ( list list -- list )
|
||||
#! Make a new list containing pairs of corresponding
|
||||
#! elements from the two given lists.
|
||||
dup [ 2uncons zip >r cons r> cons ] [ 2drop [ ] ] ifte ;
|
||||
2dup and [ 2uncons zip >r cons r> cons ] [ 2drop [ ] ] ifte ;
|
||||
|
||||
: unzip ( assoc -- keys values )
|
||||
#! Split an association list into two lists of keys and
|
||||
|
|
|
|||
|
|
@ -183,6 +183,7 @@ cpu "x86" = "mini" get not and [
|
|||
"/library/ui/events.factor"
|
||||
"/library/ui/scrolling.factor"
|
||||
"/library/ui/panes.factor"
|
||||
"/library/ui/inspector.factor"
|
||||
] [
|
||||
dup print
|
||||
run-resource
|
||||
|
|
|
|||
|
|
@ -0,0 +1,65 @@
|
|||
USING: gadgets generic hashtables kernel kernel-internals lists
|
||||
namespaces unparser vectors words ;
|
||||
|
||||
: label-box ( list -- gadget )
|
||||
<line-pile> swap [ unparse <label> over add-gadget ] each ;
|
||||
|
||||
: alist>sheet ( assoc -- sheet )
|
||||
unzip swap
|
||||
<default-shelf>
|
||||
[ >r label-box r> add-gadget ] keep
|
||||
[ >r label-box r> add-gadget ] keep ;
|
||||
|
||||
: <titled> ( gadget title -- )
|
||||
<line-pile> swap <label> over add-gadget
|
||||
[ >r empty-border r> add-gadget ] keep ;
|
||||
|
||||
: top-sheet ( obj -- sheet )
|
||||
dup class word-name <label> "Class:" <titled>
|
||||
swap unparse <label> "Object:" <titled>
|
||||
<line-pile> [ add-gadget ] keep [ add-gadget ] keep ;
|
||||
|
||||
: object>alist ( obj -- assoc )
|
||||
dup class "slots" word-property [
|
||||
cdr car [ execute ] keep swons
|
||||
] map-with ;
|
||||
|
||||
: slot-sheet ( obj -- sheet )
|
||||
object>alist alist>sheet "Slots:" <titled> ;
|
||||
|
||||
GENERIC: custom-sheet ( obj -- gadget )
|
||||
|
||||
: <inspector> ( obj -- gadget )
|
||||
0 default-gap 0 <pile>
|
||||
over top-sheet over add-gadget
|
||||
over slot-sheet over add-gadget
|
||||
swap custom-sheet over add-gadget ;
|
||||
|
||||
M: object custom-sheet drop <empty-gadget> ;
|
||||
|
||||
M: array custom-sheet ( array -- gadget )
|
||||
[ array-capacity [ count ] keep ] keep array>list zip
|
||||
alist>sheet
|
||||
"Elements:" <titled> ;
|
||||
|
||||
M: vector custom-sheet ( array -- gadget )
|
||||
dup vector-length count swap vector>list zip alist>sheet
|
||||
"Elements:" <titled> ;
|
||||
|
||||
M: hashtable custom-sheet ( array -- gadget )
|
||||
hash>alist alist>sheet "Entries:" <titled> ;
|
||||
|
||||
M: word custom-sheet ( word -- gadget )
|
||||
word-props <inspector> empty-border "Properties:" <titled> ;
|
||||
|
||||
M: tuple custom-sheet ( tuple -- gadget )
|
||||
tuple-delegate [
|
||||
<inspector> empty-border "Delegate:" <titled>
|
||||
] [
|
||||
<empty-gadget>
|
||||
] ifte* ;
|
||||
|
||||
: inspect ( obj -- )
|
||||
<inspector> ( <scroller> )
|
||||
bevel-border dup moving-actions world get add-gadget ;
|
||||
|
||||
|
|
@ -34,7 +34,10 @@ M: world inside? ( point world -- ? ) 2drop t ;
|
|||
|
||||
DEFER: handle-event
|
||||
|
||||
: layout-world ( world -- ) dup layout world-hand update-hand ;
|
||||
: layout-world ( world -- )
|
||||
dup
|
||||
0 0 width get height get <rectangle> clip set-paint-property
|
||||
dup layout world-hand update-hand ;
|
||||
|
||||
: world-step ( world -- ? )
|
||||
dup world-running? [
|
||||
|
|
@ -88,7 +91,6 @@ IN: shells
|
|||
world get shape-w world get shape-h 0 SDL_RESIZABLE
|
||||
[
|
||||
0 x set 0 y set [
|
||||
0 0 width get height get <rectangle> clip set
|
||||
title dup SDL_WM_SetCaption
|
||||
<event> run-world
|
||||
] with-screen
|
||||
|
|
|
|||
Loading…
Reference in New Issue