Forth    up http://www.forth.org
  similar languages: Postscript  
 


 CGI Squares   Michael Neumann 
\ #! /usr/bin/env gforth

: HTTP-HEADER
  ." Content-type: text/html"
  CR
  CR
;

: <HTML>   ." <HTML>" ;
: </HTML>  ." </HTML>" ;
: <HEAD>   ." <HEAD>" ;
: </HEAD>  ." </HEAD>" ;
: <TITLE>  ." <TITLE>" ;
: </TITLE> ." </TITLE>" ;
: <BODY>   ." <BODY>" ;
: </BODY>  ." </BODY>" ;
: <P>      ." <P>" ;
: </P>     ." </P>" ;
: <BR>     ." <BR> " ;
: <H1>     ." <H1>" ;
: </H1>    ." </H1>" ;

\ ============================

: squares()
  11 1 DO I DUP * . <BR> LOOP
;

\ ============================

HTTP-HEADER

<HTML>
<HEAD>
  <TITLE> ." CGI-Squares in Forth" </TITLE>
</HEAD>
<BODY>
  <H1> ." CGI-Squares in Forth" </H1>

  squares()

</BODY>
</HTML>

bye
CGI - Outputs the squares from 1 to 10.


  Discouragement example    Michael Neumann 
10000 constant ztsd  variable zs  2variable tr
: zins ztsd m/mod swap zs @ ztsd */ swap zs @ 1 */ + 1 m* ;
: restd1 2dup zins d+ tr 2@ d- ; ( d -- d )
: restd 0 do restd1 loop ; ( d -- d )
: tdauer 0 >r 2dup zins tr 2@ d< if begin r> 1 + >r restd1 2dup tr 2@ d< until
2dup d0= if 0 else 1 then r> + else ." keine Tilgung " then ; ( d -- d n )
This example only serves as discouragement!


 Hello World (1)   Michael Neumann 
( Hello World in Forth )

." Hello World"
Prints "Hello World" onto the screen.


 Hello World (2)   Michael Neumann 
\ Hello World in Forth

: say_hello ." Hello World" ;
say_hello
Prints "Hello World" onto the screen.


  Loop-Test   Michael Neumann 
: IS 0 DO I . LOOP ;
: AS 0 DO CR 1 - DUP IS LOOP ;

11 10 AS
Prints the following onto the screen:
0 1 2 3 4 5 6 7 8 9
0 1 2 3 4 5 6 7 8
0 1 2 3 4 5 6 7
0 1 2 3 4 5 6
0 1 2 3 4 5
0 1 2 3 4
0 1 2 3
0 1 2
0 1
0


 Squares   Michael Neumann 
: squares    ( to from    -->           )

  SWAP       ( to from    -->  from to   )
  1 +        ( from to    -->  from to+1 )
  SWAP       ( from to+1  -->  to+1 from )

  DO
    I DUP * .
  LOOP
;

10 1 squares
Outputs the squares from 1 to 10.


  Absolute value   ANS Forth   Michael Neumann 
: abs ( value -- value' ) DUP 0< IF NEGATE ENDIF ;



  Factorial   ANS Forth   Michael Neumann 
\ define function (definiere Funktion)

: FAC recursive       ( n-n)
  DUP 1 >
  IF                  \ if n > 1
    DUP 1 - FAC *     \   n * fac n-1
  ELSE                \ else 
    DROP 1            \   1 
  ENDIF               \ end 
;

\ call function (Funtkion aufrufen)

6 FAC .
Calculates the factorial. Results 720.


  Factorial   ANS Forth, pForth   Michael Neumann 
\ define function (definiere Funktion)

: FAC                   ( n-n)
  DUP 1 >
  IF                    \ if n > 1
    DUP 1 - RECURSE *   \   n * fac n-1
  ELSE                  \ else 
    DROP 1              \   1 
  THEN                  \ end 
;

\ call function (Funtkion aufrufen)

6 FAC .
Calculates the factorial. Results 720.