From 65d35e51ec44a6bd42cdfeb2beeab82778569ffe Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 18 Jul 2005 22:14:13 +0000
Subject: [PATCH] graphical tutorial

---
 library/ui/books.factor      |  53 ++++++
 library/ui/borders.factor    |   6 +
 library/ui/buttons.factor    |   6 +-
 library/ui/init-world.factor |   4 +-
 library/ui/load.factor       |   2 +
 library/ui/paint.factor      |  43 ++++-
 library/ui/scrolling.factor  |   7 +-
 library/ui/tutorial.factor   | 323 +++++++++++++++++++++++++++++++++++
 8 files changed, 437 insertions(+), 7 deletions(-)
 create mode 100644 library/ui/books.factor
 create mode 100644 library/ui/tutorial.factor

diff --git a/library/ui/books.factor b/library/ui/books.factor
new file mode 100644
index 0000000000..382bbc4d1d
--- /dev/null
+++ b/library/ui/books.factor
@@ -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 ;
diff --git a/library/ui/borders.factor b/library/ui/borders.factor
index e19ac14197..3600e9edb4 100644
--- a/library/ui/borders.factor
+++ b/library/ui/borders.factor
@@ -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 ;
 
diff --git a/library/ui/buttons.factor b/library/ui/buttons.factor
index ac9375d83e..82cd7eac39 100644
--- a/library/ui/buttons.factor
+++ b/library/ui/buttons.factor
@@ -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 ;
diff --git a/library/ui/init-world.factor b/library/ui/init-world.factor
index 109b92ec4d..88a41fb704 100644
--- a/library/ui/init-world.factor
+++ b/library/ui/init-world.factor
@@ -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" ]]
diff --git a/library/ui/load.factor b/library/ui/load.factor
index 1971521e0f..f693bb6e10 100644
--- a/library/ui/load.factor
+++ b/library/ui/load.factor
@@ -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"
 ] [
diff --git a/library/ui/paint.factor b/library/ui/paint.factor
index a95348a9a7..31f3021f06 100644
--- a/library/ui/paint.factor
+++ b/library/ui/paint.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 ;
diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor
index 59714734db..db072359fb 100644
--- a/library/ui/scrolling.factor
+++ b/library/ui/scrolling.factor
@@ -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 ;
 
diff --git a/library/ui/tutorial.factor b/library/ui/tutorial.factor
new file mode 100644
index 0000000000..6dd92abfc1
--- /dev/null
+++ b/library/ui/tutorial.factor
@@ -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. ;