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     "<!DOCTYPE html>" print
  44     <html>
  45       <head> <title> write </title> </head>
  46       <body>
  47         <p> write </p>
  48         <p> <a =href a> "Press to continue" write </a> </p>
  49       </body>
  50     </html>
  51   ] show 2drop ;
  52
  53 : read-number ( -- )
  54   [
  55     "<!DOCTYPE html>" print
  56     <html>
  57       <head> <title> "Enter a number" write </title> </head>
  58       <body>
  59         <form =action "post" =method form>
  60           <p>
  61             "Enter a number:" write
  62             <input "text" =type "num" =name "20" =size input/>
  63             <input "submit" =type "Press to continue" =value input/>
  64           </p>
  65         </form>
  66       </body>
  67     </html>
  68   ] show [ "num" get ] bind string>number ;
  69
  70 : guess-banner
  71   "I'm thinking of a number between 0 and 100." web-print ;
  72 : guess-prompt  ;
  73 : too-high "Too high" web-print ;
  74 : too-low "Too low" web-print ;
  75 : correct "Correct - you win!" web-print ;
  76 : inexact-guess ( actual guess -- )
  77      < [ too-high ] [ too-low ] if ;
  78
  79 : judge-guess ( actual guess -- ? )
  80     2dup = [
  81         2drop correct f
  82     ] [
  83         inexact-guess t
  84     ] if ;
  85
  86 : number-to-guess ( -- n ) 100 random ;
  87
  88 : numbers-game-loop ( actual -- )
  89     dup guess-prompt read-number judge-guess [
  90         numbers-game-loop
  91     ] [
  92         drop
  93     ] if ;
  94
  95 : numbers-game number-to-guess numbers-game-loop ;
  96
  97 "numbers-game" [ numbers-game ] install-cont-responder