graphical tutorial
Slava Pestov
parent
639d970807
commit
65d35e51ec
|
|
@ -0,0 +1,53 @@
|
|||
! Copyright (C) 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: gadgets
|
||||
USING: generic kernel lists math matrices sequences ;
|
||||
|
||||
TUPLE: book page ;
|
||||
|
||||
C: book ( pages -- book )
|
||||
<gadget> over set-delegate
|
||||
0 over set-book-page
|
||||
swap [ over add-gadget ] each ;
|
||||
|
||||
M: book pref-dim ( book -- dim )
|
||||
gadget-children { 0 0 0 } [ pref-dim vmax ] reduce ;
|
||||
|
||||
M: book layout* ( book -- )
|
||||
dup shape-dim over gadget-children [
|
||||
f over set-gadget-visible?
|
||||
{ 0 0 0 } over set-shape-loc
|
||||
set-gadget-dim
|
||||
] each-with
|
||||
dup book-page swap gadget-children nth
|
||||
t swap set-gadget-visible? ;
|
||||
|
||||
: show-page ( n book -- )
|
||||
[ gadget-children length rem ] keep
|
||||
[ set-book-page ] keep relayout ;
|
||||
|
||||
: first-page ( book -- )
|
||||
0 swap show-page ;
|
||||
|
||||
: prev-page ( book -- )
|
||||
[ book-page 1 - ] keep show-page ;
|
||||
|
||||
: next-page ( book -- )
|
||||
[ book-page 1 + ] keep show-page ;
|
||||
|
||||
: last-page ( book -- )
|
||||
-1 swap show-page ;
|
||||
|
||||
: book-buttons ( book -- gadget )
|
||||
<line-shelf> swap [
|
||||
[ "|<" first-page drop ]
|
||||
[ "<" prev-page drop ]
|
||||
[ ">" next-page drop ]
|
||||
[ ">|" last-page drop ]
|
||||
] [
|
||||
uncons swapd cons <button> over add-gadget
|
||||
] each-with ;
|
||||
|
||||
: <book-browser> ( book -- gadget )
|
||||
dup book-buttons <frame>
|
||||
[ add-top ] keep [ add-center ] keep ;
|
||||
|
|
@ -11,9 +11,15 @@ C: border ( child delegate size -- border )
|
|||
[ set-delegate ] keep
|
||||
[ over [ add-gadget ] [ 2drop ] ifte ] keep ;
|
||||
|
||||
: empty-border ( child -- border )
|
||||
<gadget> { 5 5 0 } <border> ;
|
||||
|
||||
: line-border ( child -- border )
|
||||
<etched-gadget> { 5 5 0 } <border> ;
|
||||
|
||||
: bevel-border ( child -- border )
|
||||
<bevel-gadget> { 5 5 0 } <border> ;
|
||||
|
||||
: layout-border-loc ( border -- )
|
||||
dup border-size swap gadget-child set-shape-loc ;
|
||||
|
||||
|
|
|
|||
|
|
@ -43,4 +43,8 @@ sequences io sequences styles ;
|
|||
[ drop ] [ drag 1 ] set-action ;
|
||||
|
||||
: <button> ( label quot -- button )
|
||||
>r <label> line-border dup r> button-gestures ;
|
||||
>r
|
||||
<label> bevel-border
|
||||
dup [ 216 216 216 ] background set-paint-prop
|
||||
dup
|
||||
r> button-gestures ;
|
||||
|
|
|
|||
|
|
@ -17,7 +17,9 @@ SYMBOL: stack-display
|
|||
|
||||
{{
|
||||
[[ background [ 255 255 255 ] ]]
|
||||
[[ rollover-bg [ 255 255 204 ] ]]
|
||||
[[ 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" ]]
|
||||
|
|
|
|||
|
|
@ -23,6 +23,8 @@ USING: kernel parser sequences io ;
|
|||
"/library/ui/incremental.factor"
|
||||
"/library/ui/panes.factor"
|
||||
"/library/ui/presentations.factor"
|
||||
"/library/ui/books.factor"
|
||||
"/library/ui/tutorial.factor"
|
||||
"/library/ui/init-world.factor"
|
||||
"/library/ui/ui.factor"
|
||||
] [
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: gadgets
|
||||
USING: generic hashtables io kernel lists math matrices
|
||||
namespaces sdl sequences strings styles ;
|
||||
namespaces sdl sequences strings styles vectors ;
|
||||
|
||||
SYMBOL: clip
|
||||
|
||||
|
|
@ -62,7 +62,7 @@ GENERIC: draw-gadget* ( gadget -- )
|
|||
dup rollover paint-prop rollover-bg background ?
|
||||
] ifte paint-prop ;
|
||||
|
||||
! Paint properties
|
||||
! Pen paint properties
|
||||
SYMBOL: interior
|
||||
SYMBOL: boundary
|
||||
|
||||
|
|
@ -78,6 +78,7 @@ TUPLE: solid ;
|
|||
>r x get y get r> dup shape-w swap shape-h
|
||||
>r pick + r> pick + ;
|
||||
|
||||
! Solid pen
|
||||
M: solid draw-interior
|
||||
drop >r surface get r> [ rect>screen ] keep bg rgb boxColor ;
|
||||
|
||||
|
|
@ -85,6 +86,7 @@ M: solid draw-boundary
|
|||
drop >r surface get r> [ rect>screen >r 1 - r> 1 - ] keep
|
||||
fg rgb rectangleColor ;
|
||||
|
||||
! Gradient pen
|
||||
TUPLE: gradient vector from to ;
|
||||
|
||||
: gradient-color ( gradient prop -- color )
|
||||
|
|
@ -116,6 +118,40 @@ M: gradient draw-interior ( gadget gradient -- )
|
|||
over gradient-vector { 1 0 0 } =
|
||||
[ horiz-gradient ] [ vert-gradient ] ifte ;
|
||||
|
||||
! Bevel pen
|
||||
TUPLE: bevel width ;
|
||||
|
||||
: x1/x2/y1 surface get pick pick >r 2unseq r> first swap ;
|
||||
: x1/x2/y2 surface get pick pick >r first r> 2unseq ;
|
||||
: x1/y1/y2 surface get pick pick >r 2unseq r> second ;
|
||||
: x2/y1/y2 surface get pick pick >r second r> 2unseq swapd ;
|
||||
|
||||
SYMBOL: bevel-1
|
||||
SYMBOL: bevel-2
|
||||
|
||||
: bevel-up ( gadget -- rgb )
|
||||
dup reverse-video paint-prop bevel-1 bevel-2 ? paint-prop rgb ;
|
||||
|
||||
: bevel-down ( gadget -- rgb )
|
||||
dup reverse-video paint-prop bevel-2 bevel-1 ? paint-prop rgb ;
|
||||
|
||||
: draw-bevel ( v1 v2 gadget -- )
|
||||
[ >r x1/x2/y1 r> bevel-up hlineColor ] keep
|
||||
[ >r x1/x2/y2 r> bevel-down hlineColor ] keep
|
||||
[ >r x1/y1/y2 r> bevel-up vlineColor ] keep
|
||||
[ >r x2/y1/y2 r> bevel-down vlineColor ] keep
|
||||
3drop ;
|
||||
|
||||
M: bevel draw-boundary ( gadget boundary -- )
|
||||
#! Ugly code.
|
||||
bevel-width [
|
||||
[
|
||||
>r x get y get 0 3vector over shape-dim over v+ r>
|
||||
{ 1 1 0 } n*v tuck v- { 1 1 0 } v- >r v+ r>
|
||||
rot draw-bevel
|
||||
] 2keep
|
||||
] repeat drop ;
|
||||
|
||||
M: gadget draw-gadget* ( gadget -- )
|
||||
dup
|
||||
dup interior paint-prop* draw-interior
|
||||
|
|
@ -126,3 +162,6 @@ M: gadget draw-gadget* ( gadget -- )
|
|||
|
||||
: <etched-gadget> ( -- gadget )
|
||||
<plain-gadget> dup << solid f >> boundary set-paint-prop ;
|
||||
|
||||
: <bevel-gadget> ( -- gadget )
|
||||
<plain-gadget> dup << bevel f 2 >> boundary set-paint-prop ;
|
||||
|
|
|
|||
|
|
@ -77,9 +77,9 @@ TUPLE: slider viewport thumb vector ;
|
|||
[ gadget-parent slider-motion ] [ drag 1 ] set-action ;
|
||||
|
||||
: <thumb> ( -- thumb )
|
||||
<plain-gadget>
|
||||
<bevel-gadget>
|
||||
t over set-gadget-root?
|
||||
dup gray background set-paint-prop
|
||||
dup [ 192 192 192 ] background set-paint-prop
|
||||
dup thumb-actions ;
|
||||
|
||||
: add-thumb ( thumb slider -- )
|
||||
|
|
@ -89,9 +89,10 @@ TUPLE: slider viewport thumb vector ;
|
|||
[ { 0 0 0 } slider-click ] [ button-down 1 ] set-action ;
|
||||
|
||||
C: slider ( viewport vector -- slider )
|
||||
<plain-gadget> over set-delegate
|
||||
dup [ 128 128 128 ] background set-paint-prop
|
||||
[ set-slider-vector ] keep
|
||||
[ set-slider-viewport ] keep
|
||||
f line-border over set-delegate
|
||||
<thumb> over add-thumb
|
||||
dup slider-actions ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,323 @@
|
|||
IN: gadgets
|
||||
USING: generic kernel lists math matrices namespaces sdl
|
||||
sequences styles ;
|
||||
|
||||
: <title> ( text -- gadget )
|
||||
<label> dup 36 font-size set-paint-prop ;
|
||||
|
||||
: <underline> ( -- gadget )
|
||||
<gadget>
|
||||
dup << gradient f { 1 0 0 } [ 64 64 64 ] [ 255 255 255 ] >> interior set-paint-prop
|
||||
{ 0 10 0 } over set-gadget-dim ;
|
||||
|
||||
: <page> ( list -- gadget )
|
||||
0 1 <pile>
|
||||
over car <title> over add-gadget
|
||||
<underline> over add-gadget
|
||||
swap cdr [ <label> over add-gadget ] each
|
||||
empty-border ;
|
||||
|
||||
: tutorial-pages
|
||||
[
|
||||
[
|
||||
"Factor: a dynamic language"
|
||||
"This series of slides presents a quick overview of Factor."
|
||||
""
|
||||
"Factor is interactive, which means you can test out the code"
|
||||
"in this tutorial immediately."
|
||||
""
|
||||
"http://factor.sourceforge.net"
|
||||
] [
|
||||
"The view from 10,000 feet"
|
||||
"- Everything is an object"
|
||||
"- A word is a basic unit of code"
|
||||
"- Words are identified by names, and organized in vocabularies"
|
||||
"- Words pass parameters on the stack"
|
||||
"- Code blocks can be passed as parameters to words"
|
||||
"- Word definitions are very short with very high code reuse"
|
||||
] [
|
||||
"Basic syntax"
|
||||
"Factor code is made up of whitespace-speparated tokens."
|
||||
"Here is a program that prints ``Hello world'':"
|
||||
""
|
||||
" \"hello world\" print"
|
||||
""
|
||||
"The first token (\"hello world\") is a string."
|
||||
"The second token (print) is a word."
|
||||
"The string is pushed on the stack, and the print word prints it."
|
||||
] [
|
||||
"The stack"
|
||||
"- The stack is like a pile of papers."
|
||||
"- You can ``push'' papers on the top of the pile,"
|
||||
" and ``pop'' papers from the top of the pile."
|
||||
""
|
||||
"Here is another code example:"
|
||||
""
|
||||
" 2 3 + ."
|
||||
""
|
||||
"Try running it in the listener now."
|
||||
] [
|
||||
"Postfix arithmetic"
|
||||
"What happened when you ran it?"
|
||||
""
|
||||
"The two numbers (2 3) are pushed on the stack."
|
||||
"Then, the + word pops them and pushes the result (5)."
|
||||
"Then, the . word prints this result."
|
||||
""
|
||||
"This is called postfix arithmetic."
|
||||
"Traditional arithmetic is called infix: 3 + (6 * 2)"
|
||||
"Lets translate this into postfix: 3 6 2 * + ."
|
||||
] [
|
||||
"Colon definitions"
|
||||
"We can define new words in terms of existing words."
|
||||
""
|
||||
" : twice 2 * ;"
|
||||
""
|
||||
"This defines a new word named ``twice'' that calls ``2 *''."
|
||||
"Try the following in the listener:"
|
||||
""
|
||||
" 3 twice twice ."
|
||||
""
|
||||
"The result is the same as if you wrote:"
|
||||
""
|
||||
" 3 2 * 2 * ."
|
||||
] [
|
||||
"Stack effects"
|
||||
"When we look at the definition of the ``twice'' word,"
|
||||
"it is intuitively obvious that it takes one value from the stack,"
|
||||
"and leaves one value behind. However, with more complex"
|
||||
"definitions, it is better to document this so-called"
|
||||
"``stack effect''."
|
||||
""
|
||||
"A stack effect comment is written between ( and )."
|
||||
"Factor ignores stack effect comments. Don't you!"
|
||||
""
|
||||
"The stack effect of twice is ( x -- 2*x )."
|
||||
"The stack effect of + is ( x y -- x+y )."
|
||||
"The stack effect of . is ( object -- )."
|
||||
] [
|
||||
"Shuffle words"
|
||||
"The word ``twice'' we defined is useless."
|
||||
"Let's try something more useful: squaring a number."
|
||||
""
|
||||
"We want a word with stack effect ( n -- n*n )."
|
||||
"However, we cannot use * by itself, since its stack effect"
|
||||
"is ( x y -- x*y ); it expects two inputs."
|
||||
""
|
||||
"However, we can use the word ``dup''. It has stack effect"
|
||||
"( object -- object object ), and it does exactly what we"
|
||||
"need. The ``dup'' word is known as a shuffle word."
|
||||
] [
|
||||
"The squared word"
|
||||
"Try entering the following word definition:"
|
||||
""
|
||||
" : squared ( n -- n*n ) dup * ;"
|
||||
""
|
||||
"Shuffle words solve the problem where we need to compose"
|
||||
"two words, but their stack effects do not ``fit''."
|
||||
""
|
||||
"Some of the most commonly-used shuffle words:"
|
||||
""
|
||||
"drop ( object -- )"
|
||||
"swap ( obj1 obj2 -- obj2 obj1 )"
|
||||
"over ( obj1 obj2 -- obj1 obj2 obj1 )"
|
||||
] [
|
||||
"Another shuffle example"
|
||||
"Now let us write a word that negates a number."
|
||||
"Start by entering the following in the listener"
|
||||
""
|
||||
" 0 10 - ."
|
||||
""
|
||||
"It will print -10, as expected. Now notice that this the same as:"
|
||||
""
|
||||
" 10 0 swap - ."
|
||||
""
|
||||
"So indeed, we can factor out the definition ``0 swap -'':"
|
||||
""
|
||||
" : negate ( n -- -n ) 0 swap - ;"
|
||||
] [
|
||||
"Seeing words"
|
||||
"If you have entered every definition in this tutorial,"
|
||||
"you will now have several new colon definitions:"
|
||||
""
|
||||
" twice"
|
||||
" squared"
|
||||
" negated"
|
||||
""
|
||||
"You can look at previously-entered word definitions using 'see'."
|
||||
"Try the following:"
|
||||
""
|
||||
" \ negated see"
|
||||
""
|
||||
"Prefixing a word with \ pushes it on the stack, instead of"
|
||||
"executing it. So the see word has stack effect ( word -- )."
|
||||
] [
|
||||
"Booleans"
|
||||
"In Factor, any object can be used as a truth value."
|
||||
"- The f object is false."
|
||||
"- Anything else is true."
|
||||
""
|
||||
"Here is a word that outputs a boolean:"
|
||||
""
|
||||
" : negative? ( n -- ? ) 0 < ;"
|
||||
] [
|
||||
"Branches"
|
||||
"Now suppose we want to write a word that computes the"
|
||||
"absolute value of a number; that is, if it is less than 0,"
|
||||
"the number will be negated to yield a positive result."
|
||||
""
|
||||
" : absolute ( x -- |x| )"
|
||||
" dup negative? [ negated ] when ;"
|
||||
""
|
||||
"It duplicates the top of the stack, since negative? pops it."
|
||||
"Then if the top of the stack was found to be negative,"
|
||||
"it is negated, yielding a postive result."
|
||||
] [
|
||||
"More branches"
|
||||
"On the previous slide, you saw the 'when' conditional:"
|
||||
""
|
||||
" ... condition ... [ ... code to run if true ... ] when"
|
||||
""
|
||||
"Another commonly-used form is 'unless':"
|
||||
""
|
||||
" ... condition ... [ ... code to run if true ... ] unless"
|
||||
""
|
||||
"The 'ifte' conditional takes action on both branches:"
|
||||
""
|
||||
" ... condition ... [ ... ] [ ... ] ifte"
|
||||
] [
|
||||
"Combinators"
|
||||
"ifte, when, unless are words that take lists of code as input."
|
||||
""
|
||||
"Lists of code are called ``quotations''."
|
||||
"Words that take quotations are called ``combinators''."
|
||||
""
|
||||
"Another combinator is times ( n quot -- )."
|
||||
"It calls a quotation n times."
|
||||
""
|
||||
"Try this:"
|
||||
""
|
||||
" 10 [ \"Hello combinators\" print ] times"
|
||||
] [
|
||||
"Sequences"
|
||||
"You have already seen strings, very briefly:"
|
||||
""
|
||||
" \"Hello world\""
|
||||
""
|
||||
"Strings are part of a class of objects called sequences."
|
||||
"Two other types of sequences you will use a lot are:"
|
||||
""
|
||||
" Lists: [ 1 3 \"hi\" 10 2 ]"
|
||||
" Vectors: { \"the\" [ \"quick\" \"brown\" ] \"fox\" }"
|
||||
""
|
||||
"As you can see in the second example, lists and vectors"
|
||||
"can contain any type of object, including other lists"
|
||||
"and vectors."
|
||||
] [
|
||||
"Sequences and combinators"
|
||||
"A very useful combinator is each ( seq quot -- )."
|
||||
"It calls a quotation with each element of the sequence in turn."
|
||||
""
|
||||
"Try this:"
|
||||
""
|
||||
" [ 10 20 30 ] [ . ] each"
|
||||
""
|
||||
"A closely-related combinator is map ( seq quot -- seq )."
|
||||
"It also calls a quotation with each element."
|
||||
"However, it then collects the outputs of the quotation"
|
||||
"into a new sequence."
|
||||
""
|
||||
"Try this:"
|
||||
""
|
||||
" [ 10 20 30 ] [ 3 + ] map ."
|
||||
"==> [ 13 23 33 ]"
|
||||
] [
|
||||
"Numbers - integers and ratios"
|
||||
"Factor's supports arbitrary-precision integers and ratios."
|
||||
""
|
||||
"Try the following:"
|
||||
""
|
||||
" : factorial ( n -- n! ) 0 <range> product ;"
|
||||
" 100 factorial ."
|
||||
""
|
||||
" 1 3 / 1 2 / + ."
|
||||
"==> 5/6"
|
||||
""
|
||||
"Rational numbers are added, multiplied and reduced to"
|
||||
"lowest terms in the same way you learned in grade school."
|
||||
] [
|
||||
"Numbers - higher math"
|
||||
" 2 sqrt ."
|
||||
"==> 1.414213562373095"
|
||||
""
|
||||
" -1 sqrt ."
|
||||
"==> #{ 0 1.0 }#"
|
||||
""
|
||||
" M[ [ 10 3 ] [ 7 5 ] [ -2 0 ] ]M M[ [ 11 2 ] [ 4 8 ] ]M"
|
||||
"==> M[ [ 122 44 ] [ 97 54 ] [ -22 -4 ] ]M"
|
||||
""
|
||||
"... and there is much more."
|
||||
] [
|
||||
"Object oriented programming"
|
||||
"Each object belongs to a class."
|
||||
"Generic words act differently based on an object's class."
|
||||
""
|
||||
" GENERIC: describe ( object -- )"
|
||||
" M: integer describe \"The integer \" write . ;"
|
||||
" M: string describe \"The string \" write . ;"
|
||||
" M: object describe drop \"Unknown object\" print ;"
|
||||
""
|
||||
"Each M: line defines a ``method.''"
|
||||
"Method definitions may appear in independent source files."
|
||||
""
|
||||
"integer, string, object are built-in classes."
|
||||
] [
|
||||
"Defining new classes with tuples"
|
||||
"New classes can be defined:"
|
||||
""
|
||||
" TUPLE: point x y ;"
|
||||
" M: point describe"
|
||||
" \"x =\" write dup point-x ."
|
||||
" \"y =\" write point-y . ;"
|
||||
" 100 200 <point> describe"
|
||||
""
|
||||
"A tuple is a collection of named slots."
|
||||
""
|
||||
"Tuples support custom constructors, delegation..."
|
||||
"see the developer's handbook for details."
|
||||
] [
|
||||
"The library"
|
||||
"Offers a good selection of highly-reusable words:"
|
||||
"- Operations on sequences"
|
||||
"- Variety of mathematical functions"
|
||||
"- Web server and web application framework"
|
||||
"- Graphical user interface framework"
|
||||
"Browsing the library:"
|
||||
"- To list all vocabularies:"
|
||||
" vocabs ."
|
||||
"- To list all words in a vocabulary:"
|
||||
" \"sequences\" words ."
|
||||
"- To show a word definition:"
|
||||
" \ reverse see"
|
||||
] [
|
||||
"Learning more"
|
||||
"Hopefully this tutorial has sparked your interest in Factor."
|
||||
""
|
||||
"You can learn more by reading the Factor developer's handbook:"
|
||||
""
|
||||
"http://factor.sourceforge.net/handbook.pdf"
|
||||
""
|
||||
"Also, point your IRC client to irc.freenode.net and hop in the"
|
||||
"#concatenative channel to chat with other Factor geeks."
|
||||
]
|
||||
] ;
|
||||
|
||||
: <tutorial> ( pages -- browser )
|
||||
tutorial-pages [ <page> ] map <book>
|
||||
dup [ 204 204 255 ] background set-paint-prop
|
||||
dup << gradient f { 0 1 0 } [ 204 204 255 ] [ 255 204 255 ] >> interior set-paint-prop
|
||||
dup "Sans Serif" font set-paint-prop
|
||||
dup 18 font-size set-paint-prop
|
||||
<book-browser> ;
|
||||
|
||||
: tutorial <tutorial> gadget. ;
|
||||
Loading…
Reference in New Issue