fix set-length on vectors and sbufs to not shorten the underlying array
Slava Pestov
parent
ce41c5d642
commit
3d1db6083f
|
|
@ -1,7 +1,6 @@
|
|||
76:
|
||||
---
|
||||
|
||||
- set-length should not shorten the underlying sequence
|
||||
- i/o: don't keep creating new sbufs
|
||||
- [ EAX 0 ] --> [ EAX ]
|
||||
- rollovers broken with menus
|
||||
|
|
@ -12,7 +11,6 @@
|
|||
- fix listener prompt display after presentation commands invoked
|
||||
- tutorial: clickable code snippets
|
||||
- theme abstraction in ui
|
||||
- stray gestures on stack
|
||||
|
||||
+ misc
|
||||
|
||||
|
|
|
|||
|
|
@ -15,11 +15,9 @@ BUILTIN: sbuf 13 sbuf?
|
|||
[ 1 length set-capacity ]
|
||||
[ 2 underlying set-underlying ] ;
|
||||
|
||||
M: sbuf set-length ( n sbuf -- )
|
||||
growable-check 2dup expand set-capacity ;
|
||||
M: sbuf set-length ( n sbuf -- ) grow-length ;
|
||||
|
||||
M: sbuf nth ( n sbuf -- ch )
|
||||
bounds-check underlying char-slot ;
|
||||
M: sbuf nth ( n sbuf -- ch ) bounds-check underlying char-slot ;
|
||||
|
||||
M: sbuf set-nth ( ch n sbuf -- )
|
||||
growable-check 2dup ensure underlying
|
||||
|
|
|
|||
|
|
@ -108,3 +108,7 @@ GENERIC: set-capacity
|
|||
] [
|
||||
2drop
|
||||
] ifte ;
|
||||
|
||||
: grow-length ( len seq -- )
|
||||
growable-check 2dup length > [ 2dup expand ] when
|
||||
set-capacity ;
|
||||
|
|
|
|||
|
|
@ -9,11 +9,9 @@ BUILTIN: vector 11 vector?
|
|||
[ 1 length set-capacity ]
|
||||
[ 2 underlying set-underlying ] ;
|
||||
|
||||
M: vector set-length ( len vec -- )
|
||||
growable-check 2dup expand set-capacity ;
|
||||
M: vector set-length ( len vec -- ) grow-length ;
|
||||
|
||||
M: vector nth ( n vec -- obj )
|
||||
bounds-check underlying array-nth ;
|
||||
M: vector nth ( n vec -- obj ) bounds-check underlying array-nth ;
|
||||
|
||||
M: vector set-nth ( obj n vec -- )
|
||||
growable-check 2dup ensure underlying set-array-nth ;
|
||||
|
|
|
|||
|
|
@ -1,58 +0,0 @@
|
|||
! Copyright (C) 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: help
|
||||
DEFER: tutorial
|
||||
|
||||
IN: gadgets
|
||||
USING: generic help io kernel listener math namespaces
|
||||
prettyprint sequences styles threads words ;
|
||||
|
||||
SYMBOL: stack-display
|
||||
|
||||
: ui.s ( -- )
|
||||
stack-display get dup pane-clear [
|
||||
datastack reverse [ unparse. terpri ] each
|
||||
] with-stream* ;
|
||||
|
||||
: init-world
|
||||
global [
|
||||
<world> world set
|
||||
|
||||
{{
|
||||
[[ background [ 255 255 255 ] ]]
|
||||
[[ rollover-bg [ 216 216 255 ] ]]
|
||||
[[ bevel-1 [ 160 160 160 ] ]]
|
||||
[[ bevel-2 [ 216 216 216 ] ]]
|
||||
[[ foreground [ 0 0 0 ] ]]
|
||||
[[ reverse-video f ]]
|
||||
[[ font "Sans Serif" ]]
|
||||
[[ font-size 12 ]]
|
||||
[[ font-style plain ]]
|
||||
}} world get set-gadget-paint
|
||||
|
||||
{ 1024 768 0 } world get set-gadget-dim
|
||||
|
||||
<plain-gadget> add-layer
|
||||
|
||||
<pane> dup pane set <scroller>
|
||||
<pane> dup stack-display set <scroller>
|
||||
3/4 <y-splitter> add-layer
|
||||
|
||||
[
|
||||
pane get [
|
||||
[ ui.s ] listener-hook set
|
||||
clear print-banner
|
||||
"Tutorial" [ drop [ tutorial ] pane get pane-call ] <button> gadget.
|
||||
listener
|
||||
] with-stream
|
||||
] in-thread
|
||||
|
||||
pane get request-focus
|
||||
] bind ;
|
||||
|
||||
SYMBOL: first-time
|
||||
|
||||
global [ first-time on ] bind
|
||||
|
||||
: ?init-world
|
||||
first-time get [ init-world first-time off ] when ;
|
||||
|
|
@ -23,7 +23,6 @@ USING: kernel parser sequences io ;
|
|||
"/library/ui/panes.factor"
|
||||
"/library/ui/presentations.factor"
|
||||
"/library/ui/books.factor"
|
||||
"/library/ui/init-world.factor"
|
||||
"/library/ui/ui.factor"
|
||||
] [
|
||||
dup print run-resource
|
||||
|
|
|
|||
|
|
@ -1,8 +1,61 @@
|
|||
! Copyright (C) 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: gadgets
|
||||
USING: kernel namespaces sdl sequences ;
|
||||
IN: help
|
||||
DEFER: tutorial
|
||||
|
||||
IN: gadgets
|
||||
USING: generic help io kernel listener math namespaces
|
||||
prettyprint sdl sequences styles threads words ;
|
||||
|
||||
SYMBOL: stack-display
|
||||
|
||||
: ui.s ( -- )
|
||||
stack-display get dup pane-clear [
|
||||
datastack reverse [ unparse. terpri ] each
|
||||
] with-stream* ;
|
||||
|
||||
: init-world
|
||||
global [
|
||||
<world> world set
|
||||
|
||||
{{
|
||||
[[ background [ 255 255 255 ] ]]
|
||||
[[ rollover-bg [ 216 216 255 ] ]]
|
||||
[[ bevel-1 [ 160 160 160 ] ]]
|
||||
[[ bevel-2 [ 216 216 216 ] ]]
|
||||
[[ foreground [ 0 0 0 ] ]]
|
||||
[[ reverse-video f ]]
|
||||
[[ font "Sans Serif" ]]
|
||||
[[ font-size 12 ]]
|
||||
[[ font-style plain ]]
|
||||
}} world get set-gadget-paint
|
||||
|
||||
{ 1024 768 0 } world get set-gadget-dim
|
||||
|
||||
<plain-gadget> add-layer
|
||||
|
||||
<pane> dup pane set <scroller>
|
||||
<pane> dup stack-display set <scroller>
|
||||
3/4 <y-splitter> add-layer
|
||||
|
||||
[
|
||||
pane get [
|
||||
[ ui.s ] listener-hook set
|
||||
clear print-banner
|
||||
"Tutorial" [ drop [ tutorial ] pane get pane-call ] <button> gadget.
|
||||
listener
|
||||
] with-stream
|
||||
] in-thread
|
||||
|
||||
pane get request-focus
|
||||
] bind ;
|
||||
|
||||
SYMBOL: first-time
|
||||
|
||||
global [ first-time on ] bind
|
||||
|
||||
: ?init-world
|
||||
first-time get [ init-world first-time off ] when ;
|
||||
IN: shells
|
||||
|
||||
: ui ( -- )
|
||||
|
|
|
|||
Loading…
Reference in New Issue