From 06fd239a6fe6ec9eaf5f2d3dfa4f35c93940959c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 23 Jul 2005 03:39:28 +0000 Subject: [PATCH] updated examples --- examples/dejong.factor | 11 +---- examples/dump.factor | 30 ------------- examples/format.factor | 35 --------------- examples/lcd.factor | 8 ++-- examples/more-random.factor | 86 ------------------------------------ examples/numbers-game.factor | 17 ++----- examples/plot3d.factor | 2 + examples/quadratic.factor | 46 ------------------- examples/timesheet.factor | 67 ---------------------------- 9 files changed, 11 insertions(+), 291 deletions(-) delete mode 100644 examples/dump.factor delete mode 100644 examples/format.factor delete mode 100644 examples/more-random.factor delete mode 100644 examples/quadratic.factor delete mode 100644 examples/timesheet.factor diff --git a/examples/dejong.factor b/examples/dejong.factor index 4101ee71da..3ceb15535c 100644 --- a/examples/dejong.factor +++ b/examples/dejong.factor @@ -17,16 +17,7 @@ ! http://www.complexification.net/gallery/machines/peterdejong/ IN: dejong - -USE: sdl -USE: sdl-event -USE: sdl-gfx -USE: sdl-video -USE: namespaces -USE: math -USE: kernel -USE: test -USE: compiler +USING: compiler kernel math namespaces sdl styles test ; SYMBOL: a SYMBOL: b diff --git a/examples/dump.factor b/examples/dump.factor deleted file mode 100644 index 536921fc4b..0000000000 --- a/examples/dump.factor +++ /dev/null @@ -1,30 +0,0 @@ -! Copyright (C) 2004, 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. -IN: dump -USING: alien assembler generic kernel kernel-internals lists -math memory sequences io strings unparser ; - -: cell. >hex cell 2 * CHAR: 0 pad write ; - -: slot@ ( address n -- n ) cell * swap 7 bitnot bitand + ; - -: dump-line ( address n value -- ) - >r slot@ cell. ": " write r> cell. terpri ; - -: (dump) ( address list -- ) - 0 swap [ >r 2dup r> dump-line 1 + ] each 2drop ; - -: integer-slots ( obj -- list ) - dup size cell / [ integer-slot ] project-with ; - -: dump ( obj -- ) - #! Dump an object's memory. - dup address swap integer-slots (dump) ; - -: alien-slots ( address length -- list ) - cell / [ cell * alien-unsigned-4 ] project-with ; - -: dump* ( alien len -- ) - #! Dump an alien's memory. - dup string? [ c-size ] when - >r [ alien-address ] keep r> alien-slots (dump) ; diff --git a/examples/format.factor b/examples/format.factor deleted file mode 100644 index 3c5c8c0fce..0000000000 --- a/examples/format.factor +++ /dev/null @@ -1,35 +0,0 @@ -IN: format -USING: kernel math sequences strings test ; - -: decimal-split ( string -- string string ) - #! Split a string before and after the decimal point. - dup "." index-of dup -1 = [ drop f ] [ string// ] ifte ; - -: decimal-tail ( count str -- string ) - #! Given a decimal, trims all but a count of decimal places. - [ length min ] keep string-head ; - -: decimal-cat ( before after -- string ) - #! If after is of zero length, return before, otherwise - #! return "before.after". - dup length 0 = [ - drop - ] [ - "." swap cat3 - ] ifte ; - -: decimal-places ( num count -- string ) - #! Trims the number to a count of decimal places. - >r decimal-split dup [ - r> swap decimal-tail decimal-cat - ] [ - r> 2drop - ] ifte ; - -[ "123" ] [ 4 "123" decimal-tail ] unit-test -[ "12" ] [ 2 "123" decimal-tail ] unit-test -[ "123" ] [ "123" 2 decimal-places ] unit-test -[ "123.12" ] [ "123.12" 2 decimal-places ] unit-test -[ "123.123" ] [ "123.123" 5 decimal-places ] unit-test -[ "123" ] [ "123.123" 0 decimal-places ] unit-test - diff --git a/examples/lcd.factor b/examples/lcd.factor index 0414501fb2..4d0ca565e5 100644 --- a/examples/lcd.factor +++ b/examples/lcd.factor @@ -1,14 +1,14 @@ -USING: sequences kernel math io strings ; +USING: sequences kernel math io ; : lcd-digit ( digit row -- str ) { " _ _ _ _ _ _ _ _ " " | | | _| _| |_| |_ |_ | |_| |_| " " |_| | |_ _| | _| |_| | |_| | " - } nth >r 4 * dup 4 + r> substring ; + } nth >r 4 * dup 4 + r> subseq ; : lcd-row ( num row -- ) - swap [ CHAR: 0 - over lcd-digit write ] each drop ; + swap [ CHAR: 0 - swap lcd-digit write ] each-with ; -: lcd ( num -- str ) +: lcd ( digit-str -- ) 3 [ 2dup lcd-row terpri ] repeat drop ; diff --git a/examples/more-random.factor b/examples/more-random.factor deleted file mode 100644 index 7a208f19fd..0000000000 --- a/examples/more-random.factor +++ /dev/null @@ -1,86 +0,0 @@ -IN: random -USING: kernel lists math namespaces sequences test ; - -: random-element ( list -- random ) - #! Returns a random element from the given list. - [ length 1 - 0 swap random-int ] keep nth ; - -: random-boolean ( -- ? ) 0 1 random-int 0 = ; - -: random-subset ( list -- list ) - #! Returns a random subset of the given list. Each item is - #! chosen with a 50% - #! probability. - [ drop random-boolean ] subset ; - -: car+ ( list -- sum ) - #! Adds the car of each element of the given list. - 0 swap [ car + ] each ; - -: random-probability ( list -- sum ) - #! Adds the car of each element of the given list, and - #! returns a random number between 1 and this sum. - 1 swap car+ random-int ; - -: random-element-iter ( list index -- elem ) - #! Used by random-element*. Do not call directly. - >r unswons unswons r> ( list elem probability index ) - swap - ( list elem index ) - dup 0 <= [ - drop nip - ] [ - nip random-element-iter - ] ifte ; - -: random-element* ( list -- elem ) - #! Returns a random element of the given list of comma - #! pairs. The car of each pair is a probability, the cdr is - #! the item itself. Only the cdr of the comma pair is - #! returned. - dup 1 swap car+ random-int random-element-iter ; - -: random-subset* ( list -- list ) - #! Returns a random subset of the given list of comma pairs. - #! The car of each pair is a probability, the cdr is the - #! item itself. Only the cdr of the comma pair is returned. - [ - [ car+ ] keep ( probabilitySum list ) - [ - >r 1 over random-int r> ( probabilitySum probability elem ) - uncons ( probabilitySum probability elema elemd ) - -rot ( probabilitySum elemd probability elema ) - > ( probabilitySum elemd boolean ) - [ drop ] [ , ] ifte - ] each drop - ] make-list ; - -: check-random-subset ( expected pairs -- ) - random-subset* [ over contains? ] all? nip ; - -[ - [ t ] - [ [ 1 2 3 ] random-element number? ] - unit-test - - [ - [[ 10 t ]] - [[ 20 f ]] - [[ 30 "monkey" ]] - [[ 24 1/2 ]] - [[ 13 { "Hello" "Banana" } ]] - ] "random-pairs" set - - "random-pairs" get [ cdr ] map "random-values" set - - [ f ] - [ - "random-pairs" get - random-element* "random-values" get contains? not - ] unit-test - - [ t ] [ - "random-values" get - "random-pairs" get - check-random-subset - ] unit-test -] with-scope diff --git a/examples/numbers-game.factor b/examples/numbers-game.factor index 324f9ad287..00e45e2368 100644 --- a/examples/numbers-game.factor +++ b/examples/numbers-game.factor @@ -1,9 +1,7 @@ -! Numbers game example - IN: numbers-game USING: kernel math parser random io ; -: read-number ( -- n ) read parse-number ; +: read-number ( -- n ) readln parse-number ; : guess-banner "I'm thinking of a number between 0 and 100." print ; @@ -16,19 +14,12 @@ USING: kernel math parser random io ; < [ too-high ] [ too-low ] ifte ; : judge-guess ( actual guess -- ? ) - 2dup = [ - 2drop correct f - ] [ - inexact-guess t - ] ifte ; + 2dup = [ 2drop correct f ] [ inexact-guess t ] ifte ; : number-to-guess ( -- n ) 0 100 random-int ; : numbers-game-loop ( actual -- ) - dup guess-prompt read-number judge-guess [ - numbers-game-loop - ] [ - drop - ] ifte ; + dup guess-prompt read-number judge-guess + [ numbers-game-loop ] [ drop ] ifte ; : numbers-game number-to-guess numbers-game-loop ; diff --git a/examples/plot3d.factor b/examples/plot3d.factor index 69358ccdf0..76f50b5904 100644 --- a/examples/plot3d.factor +++ b/examples/plot3d.factor @@ -152,3 +152,5 @@ SYMBOL: theta make-plot event-loop SDL_Quit ] with-screen ; + +plot3d diff --git a/examples/quadratic.factor b/examples/quadratic.factor deleted file mode 100644 index 43564a0bea..0000000000 --- a/examples/quadratic.factor +++ /dev/null @@ -1,46 +0,0 @@ -! :folding=indent:collapseFolds=0: - -! $Id$ -! -! Copyright (C) 2004 Slava Pestov. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -IN: quadratic -USE: math -USE: kernel - -: quadratic-e ( b a -- -b/2a ) - 2 * / neg ; - -: quadratic-d ( a b c -- d ) - pick 4 * * swap sq swap - swap sq 4 * / sqrt ; - -: quadratic-roots ( d e -- alpha beta ) - 2dup + -rot - ; - -: quadratic ( a b c -- alpha beta ) - #! Finds both roots of the polynomial a*x^2 + b*x + c - #! using the quadratic formula. - 3dup quadratic-d - nip swap rot quadratic-e - swap quadratic-roots ; diff --git a/examples/timesheet.factor b/examples/timesheet.factor deleted file mode 100644 index 75259ef698..0000000000 --- a/examples/timesheet.factor +++ /dev/null @@ -1,67 +0,0 @@ -! Contractor timesheet example - -IN: timesheet -USING: errors kernel lists math namespaces sequences io -strings unparser vectors ; - -! Adding a new entry to the time sheet. - -: measure-duration ( -- duration ) - millis - read drop - millis swap - 1000 /i 60 /i ; - -: add-entry-prompt ( -- duration description ) - "Start work on the task now. Press ENTER when done." print - measure-duration - "Please enter a description:" print - read ; - -: add-entry ( timesheet -- ) - add-entry-prompt cons swap push ; - -! Printing the timesheet. - -: hh ( duration -- str ) 60 /i ; -: mm ( duration -- str ) 60 mod unparse 2 "0" pad ; -: hh:mm ( millis -- str ) [ dup hh , ":" , mm , ] make-string ; - -: pad-string ( len str -- str ) - length - " " fill ; - -: print-entry ( duration description -- ) - dup write - 60 swap pad-string write - hh:mm print ; - -: print-timesheet ( timesheet -- ) - "TIMESHEET:" print - [ uncons print-entry ] each ; - -! Displaying a menu - -: print-menu ( menu -- ) - terpri [ cdr car print ] each terpri - "Enter a letter between ( ) to execute that action." print ; - -: menu-prompt ( menu -- ) - read swap assoc dup [ - cdr call - ] [ - "Invalid input: " swap unparse cat2 throw - ] ifte ; - -: menu ( menu -- ) - dup print-menu menu-prompt ; - -! Main menu - -: main-menu ( timesheet -- ) - [ - [ "e" "(E)xit" drop ] - [ "a" "(A)dd entry" dup add-entry main-menu ] - [ "p" "(P)rint timesheet" dup print-timesheet main-menu ] - ] menu ; - -: timesheet-app ( -- ) - 10 main-menu ;