unmaintained/webapps/numbers/numbers.factor

   1 ! cont-number-guess
   2 !
   3 ! Copyright (C) 2004 Chris Double.
   4 !
   5 ! Redistribution and use in source and binary forms, with or without
   6 ! modification, are permitted provided that the following conditions are met:
   7 !
   8 ! 1. Redistributions of source code must retain the above copyright notice,
   9 !    this list of conditions and the following disclaimer.
  10 !
  11 ! 2. Redistributions in binary form must reproduce the above copyright notice,
  12 !    this list of conditions and the following disclaimer in the documentation
  13 !    and/or other materials provided with the distribution.
  14 !
  15 ! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  16 ! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
  17 ! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  18 ! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  19 ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  20 ! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
  21 ! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  22 ! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  23 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  24 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  25 !
  26 ! This example modifies the console based 'numbers-game' example
  27 ! in a very minimal way to demonstrate conversion of a console
  28 ! program to a web based application.
  29 !
  30 ! All that was required was changing the input and output functions
  31 ! to use HTML. The remaining code was untouched.
  32 !
  33 ! The result is not that pretty but it shows the basic idea.
  34 USING: kernel math parser html html.elements io namespaces
  35 math.parser random webapps.continuation ;
  36
  37 IN: webapps.numbers
  38
  39 : web-print ( str -- )
  40   #! Display the string in a web page.
  41   [
  42     swap dup
  43     <html>
  44       <head> <title> write </title> </head>
  45       <body>
  46         <p> write </p>
  47         <p> <a =href a> "Press to continue" write </a> </p>
  48       </body>
  49     </html>
  50   ] show 2drop ;
  51
  52 : read-number ( -- )
  53   [
  54     <html>
  55       <head> <title> "Enter a number" write </title> </head>
  56       <body>
  57         <form =action "post" =method form>
  58           <p>
  59             "Enter a number:" write
  60             <input "text" =type "num" =name "20" =size input/>
  61             <input "submit" =type "Press to continue" =value input/>
  62           </p>
  63         </form>
  64       </body>
  65     </html>
  66   ] show [ "num" get ] bind string>number ;
  67
  68 : guess-banner
  69   "I'm thinking of a number between 0 and 100." web-print ;
  70 : guess-prompt  ;
  71 : too-high "Too high" web-print ;
  72 : too-low "Too low" web-print ;
  73 : correct "Correct - you win!" web-print ;
  74 : inexact-guess ( actual guess -- )
  75      < [ too-high ] [ too-low ] if ;
  76
  77 : judge-guess ( actual guess -- ? )
  78     2dup = [
  79         2drop correct f
  80     ] [
  81         inexact-guess t
  82     ] if ;
  83
  84 : number-to-guess ( -- n ) 100 random ;
  85
  86 : numbers-game-loop ( actual -- )
  87     dup guess-prompt read-number judge-guess [
  88         numbers-game-loop
  89     ] [
  90         drop
  91     ] if ;
  92
  93 : numbers-game number-to-guess numbers-game-loop ;
  94
  95 "numbers-game" [ numbers-game ] install-cont-responder