Benutzer-Werkzeuge

Webseiten-Werkzeuge


projects:sample3.blk

EXAMPLES FOR LECTURE #3

Screen 0 not modified     
 0 \ EXAMPLES FOR LECTURE #3                      11:25JWB01/24/86 
 1 \ Last change:   Screen  001                   15:36JWB04/22/87 
 2                                                                 
 3         Number displaying words.                                
 4                                                                 
 5         Logicals and conditionals.                              
 6                                                                 
 7         Conditional structures.  IF ... ELSE ... THEN           
 8                                                                 
 9         Character and numeric input.                            
10                                                                 
11         Return stack.                                           
12                                                                 
13         Square root.                                            
14                                                                 
15                                                                 


Screen 1 not modified     
 0 \  Load screen for help system.                15:36JWB04/22/87 
 1                                                                 
 2 \ The word FROM temporarily redirects the input to the          
 3 \ indicated block file for ONE screen load only.                
 4 \ However.... that one screen could specify that others be      
 5 \ loaded.  This is the case with screen one of sample1.blk.     
 6 \ Go back and check it yourself.                                
 7                                                                 
 8         FROM A:SAMPLE1.BLK 1 LOAD    \ Load the HELP system.    
 9         FROM A:SAMPLE1.BLK 9 LOAD    \ Load MQUIT               
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 2 not modified     
 0 \ REVIEW - 1    DEBUGGER                       11:14JWB01/24/86 
 1 The debugger is designed to let the user single step through    
 2 the execution sequence of a high level definition. This process 
 3 is also called tracing.  To activate the debugger type:         
 4                                                                 
 5         DEBUG   <name>                                          
 6                                                                 
 7 where <name> is the word to be debugged or traced.  When the    
 8 word <name> is next executed you will get a single step trace   
 9 showing the next word to be executed and the contents of the    
10 data stack. Press any key except C F or Q for the next step.    
11         Q   -  Quit debugging process.                          
12         C   -  Continue without pausing between steps.          
13         F   -  Return to FORTH to execute other commands.       
14             -  You must type  RESUME to continue debugging.     
15     UNBUG   - Disconnect the debugger.                          


Screen 3 not modified     
 0 \ REVIEW - 2   STACK OPERATORS                 19:23JWB09/26/85 
 1   DROP  ( n   -- )      Drop top number on data stack.          
 2   SWAP  ( n m   m n )   Swap top two numbers on data stack.     
 3   DUP   ( n   n n )     Duplicate top number on data stack.     
 4   OVER  ( n m   n m n ) Make copy of second item to top of stack
 5   ROT   ( a b c  b c a) Rotate third item to the top of stack.  
 6  -ROT   ( a b c  c a b) Rotate in opposite direction.           
 7   PICK  ( ? n    ? nth) Copy nth item to top of stack (0 based).
 8   ROL   ( ? n    ? nth) Rotate nth item to top (0 based).       
 9   NIP   ( n m    m )    Discard second item on data stack.      
10   TUCK  ( n m    m n m) Push copy of top under second item.     
11   3DUP  ( a b c  a b c a b c)  Make copy of top 3 items.        
12   2DROP ( dn     -- )   Drop double number from top.            
13   2SWAP ( dn dm   dm dn) Swap top two double numbers.           
14   2DUP  ( dn      dn dn) Make another copy of top double number.
15   2OVER ( dn dm   dn dm dn) Copy second double number to top.   


Screen 4 not modified     
 0 \ REVIEW - 3                                   19:46JWB09/26/85 
 1 \ Floored symmetric division.  Note that q and r must satisfy   
 2 \ the equations:   m/n  = q  +  r/n    or  m = nq + r           
 3                                                                 
 4   /     ( m n   q )     Leave q , the floor of real quotient.   
 5   MOD   ( m n   r )     Leave r , remainder (satisfying above). 
 6   /MOD  ( m n   r q )   Leave remainder r and quotient q .      
 7 Quiz:   m    n      r     q       Check:  n * q   +  r          
 8        13    5                            5 *                   
 9       -11    5                            5 *                   
10        -2    5                            5 *                   
11                                                                 
12        13   -5                           -5 *                   
13       -11   -5                           -5 *                   
14        -2   -5                           -5 *                   
15                                                                 


Screen 5 not modified     
 0 \ REVIEW - 4    Easy Words                     20:03JWB09/26/85 
 1   1+    ( n   n+1 )     Increment top stack item by 1.          
 2   2+    ( n   n+2 )     Increment top stack item by 2.          
 3   1-    ( n   n-1 )     Decrement top stack item by 1.          
 4   2-    ( n   n-2 )     Decrement top stack item by 2.          
 5   2*    ( n   2n  )     Multiply  top stack item by 2.          
 6   2/    ( n   n/2 )     Divide    top stack item by 2.          
 7   ABS   ( n   |n| )     Replace top item by its absolute value. 
 8   NEGATE ( n   -n )     Negatate top stack item.                
 9                                                                 
10 \  These may help recover from wierd  LOADing errors.           
11    HIDE   ( --   -- )  Mark last word so it cannot be found.    
12    REVEAL ( --   -- )  Mark last word so it can be found.       
13    [                   Stop compiling and resume interpretation.
14    ]                   Stop interpreting and resume compilation.
15                                                                 


Screen 6 not modified     
 0 \ Number displaying words.                     20:26JWB09/26/85 
 1 \ Single signed 16bit numbers.   -32768 - 32767                 
 2   .     ( n     -- )  Display signed 16bit # followed by space. 
 3   .R    ( n w   -- )  Display # right justified in w wide field.
 4                                                                 
 5 \ Single unsigned 16bit numbers.  0 - 65535                     
 6   U.    ( u     -- )  Display unsigned 16bit # followed by space
 7   U.R   ( u w   -- )  Display # right justified in w wide field.
 8                                                                 
 9 \ Double signed 32bit numbers   -2,147,483,648 - 2,147,483,647  
10  D.     ( d     -- )  Display signed 32bit # followed by space. 
11  D.R    ( d w   -- )  Display # right justified in w wide field.
12                                                                 
13 \ Double unsigned 32bit numbers.  0 - 4,294,967,296             
14  UD.    ( ud    -- )  Display unsigned 32bit # followed by space
15  UD.R   ( ud w  -- )  Display # right justified in w wide field.


Screen 7 not modified     
 0 \ Logicals and conditionals.                   20:52JWB09/26/85 
 1 \ tf = true flag = -1      ff = false flag = 0                  
 2 \ flag = true flag or false flag.                               
 3   TRUE  ( --   tf )     Leave true flag on top of data stack.   
 4   FALSE ( --   ff )     Leave false flag on top of data stack.  
 5   =     ( n m   flag )  Leave tf if n = m , otherwise ff.       
 6   <>    ( n m   flag )  Leave tf if n<> m , otherwise ff.       
 7   <     ( n m   flag )  Leave tf if n < m , otherwise ff.       
 8   >     ( n m   flag )  Leave tf if n > m , otherwise ff.       
 9   0=    ( n    flag )   Leave tf if n = 0 , otherwise ff.       
10   0<>   ( n    flag )   Leave tf if n<> 0 , otherwise ff.       
11   0<    ( n    flag )   Leave tf if n < 0 , otherwise ff.       
12   0>    ( n    flag )   Leave tf if n > 0 , otherwise ff.       
13   AND   ( f1 f2  flag ) Leave tf only if f1 and f2 are true.    
14   OR    ( f1 f2  flag ) Leave tf if either f1 or f2 are true.   
15   NOT   ( f1   not-f1 ) Reverse the flag f1.                    


Screen 8 not modified     
 0 \ Ex 1 (IN) Prob 1  & Conditional Structur     11:10JWB09/29/85 
 1 \ (IN)  leaves a true flag if   a < x < b                       
 2 : (IN)  ( x a b   flag )                                        
 3          -ROT OVER < -ROT > AND ;                               
 4 \ Problem 1: Write words related to (IN) which do the following.
 5 \ [IN]  leaves a true flag if a <= x <= b  , otherwise false.   
 6 \ (IN]  leaves a true flag if a <  x <= b  , otherwise false.   
 7 \ [IN)  leaves a true flag if a <= x <  b  , otherwise false.   
 8                                                                 
 9 \ CONDITIONAL STRUCTURES ... USE ONLY WITHIN A COLON DEFINITION.
10 \   condition  IF   do this part only if true                   
11 \              THEN continue                                    
12                                                                 
13 \   condition  IF   do this part only if true                   
14 \              ELSE do this part only if false                  
15 \              THEN continue                                    


Screen 9 not modified     
 0 \ Example 2 , Problem 2  & 3                   20:20JWB09/28/85 
 1 : TEST  ( n   -- )   \ Determine if number is even or odd.      
 2         CR DUP ." THE NUMBER " .  ." IS AN "                    
 3         DUP 2/  2* =                                            
 4         IF      ." EVEN "                                       
 5         ELSE    ."  ODD "                                       
 6         THEN    ." NUMBER"  ;                                   
 7 \ Problem 2                                                     
 8 \ Write word similar to TEST , whose output is a sentence       
 9 \ stating whether the top number on the stack is positive ,     
10 \ zero  or negative.                                            
11                                                                 
12 \ Problem 3                                                     
13 \ Write a word called  EVEN  ( n   flag )  , that takes a stack 
14 \ input n and leaves a true flag if n is even and a false flag  
15 \ if n is odd.                                                  


Screen 10 not modified     
 0 \  Terminating an infinite loop.               20:54JWB09/28/85 
 1 \  New Word:  KEY   Wait for user to press key on keyboard and  
 2 \  KEY  ( --   n )  return the keycode n.                       
 3 \  Old Word:  EXIT  Stops screen compilation when not in a : def
 4 \  EXIT ( --  -- )  When compiled in a word, EXIT , will cause  
 5 \       termination of word execution when encountered.         
 6 :  KEY_TEST                                                     
 7         BEGIN  CR  KEY                                          
 8         DUP  CONTROL M  =    \  Control M is return key.        
 9         IF DROP EXIT THEN    \  Exit infinite loop if pressed.  
10         DUP .  EMIT          \  Otherwise show key pressed.     
11         AGAIN ;                                                 
12 \ Return  ASCII code and tf or  function code and ff.           
13 : PCKEY  ( --   n  flag )                                       
14        KEY DUP IF TRUE ELSE KEY SWAP THEN ;                     
15 \ Problem 4  Put this word in a loop and document function keys.


Screen 11 not modified     
 0 \ Example - 3 Super simple numeric input.      23:36JWB09/28/85 
 1 :  #IN QUERY  INTERPRET ;                                       
 2                                                                 
 3 : GETL  ( --   l )  CR ." Enter tank length " #IN ;             
 4 : GETW  ( --   w )  CR ." Enter tank width  " #IN ;             
 5 : GETH  ( --   h )  CR ." Enter tank height " #IN ;             
 6                                                                 
 7 : .VOLUME ( l w h  -- )                                         
 8         * *  CR  ." Volume "  .  ." cubic feet." ;              
 9 : .AREA   ( l w h  -- )                                         
10         3DUP 5 ROLL * 2* -ROT * 2* + -ROT * 2* +                
11         CR ." Surface area " . ." square feet." ;               
12                                                                 
13 : TANK  ( --   -- )                                             
14         GETL  GETW  GETH                                        
15         3DUP  .VOLUME    .AREA ;                                


Screen 12 not modified     
 0 \ Support words for better #IN                 21:50JWB09/28/85 
 1                                                                 
 2 : DIGIT?  ( n    flag )                                         
 3         DUP 47 > SWAP 58 < AND ;                                
 4                                                                 
 5 : RUBOUT  ( --   -- )                                           
 6         8 EMIT 32 EMIT 8 EMIT ;                                 
 7                                                                 
 8 : -DIGIT  ( n   n/10 )                                          
 9         10 / ;                                                  
10                                                                 
11 : +DIGIT  ( n c   10n+c-48)                                     
12         48 - SWAP 10 * + ;                                      
13                                                                 
14 -->                                                             
15                                                                 


Screen 13 not modified     
 0 \ Better, but not so simple # input.           21:51JWB09/28/85 
 1 : #IN   ( --   num )                                            
 2         0  BEGIN  KEY               \ Fetch a key press.        
 3   DUP 13 = IF DROP EXIT THEN        \ Exit if done.             
 4   DUP  8 = IF   DROP RUBOUT -DIGIT  \ Erase and correct.        
 5            ELSE DUP  DIGIT?         \ Was digit pressed?        
 6                 IF   DUP EMIT       \ Echo digit                
 7                      +DIGIT         \ Convert digit.            
 8                 ELSE DROP 7 EMIT    \ Invalid key.              
 9                 THEN                                            
10            THEN                                                 
11            AGAIN ;                                              
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 14 not modified     
 0 \ Support words for best #IN                   21:52JWB09/28/85 
 1 : DIGIT?  ( n    flag )    \ Leave true flag if valid digit.    
 2         DUP 47 > SWAP 58 < AND ;                                
 3 : RUBOUT  ( --   -- )       \ Rub out most recent digit         
 4         8 EMIT 32 EMIT 8 EMIT ;                                 
 5 \ Note:  -DIGIT & +DIGIT are changed from screen 11 !!          
 6 \ Remove digit from screen and number then dec digit count.     
 7 : -DIGIT  ( cnt n    cnt-1 n/10 )                               
 8         RUBOUT SWAP 1- SWAP 0 10 UM/MOD NIP ; \ Unsigned divide.
 9 \ Increment digit count and add in digit.                       
10 : +DIGIT  ( cnt n key   cnt+1 10n+key-48)                       
11         SWAP 10 UM* 2 PICK 48 - 0 D+ 32767. 2OVER DU<           
12         IF   10 UM/MOD NIP NIP BEEP                             
13         ELSE DROP SWAP EMIT SWAP 1+ SWAP THEN ;                 
14 : RESET   ( flg cnt n   ff cnt n )   \  Reset sign flag.        
15         ROT DROP FALSE -ROT ;  -->                              


Screen 15 not modified     
 0 \ Support words for the best # input.          22:15JWB09/28/85 
 1 \ Correct an error input.                                       
 2 : CORRECT.IT ( flg cnt num key   flg cnt num )                  
 3        DROP OVER  0<>         \ Is digit count non zero?        
 4        IF   -DIGIT            \ Remove most recent digit.       
 5        ELSE BEEP RESET THEN ; \ Beep and reset if count is 0.   
 6 \ Process all other keystrokes.                                 
 7 : PROCESS.IT ( flg cnt num key   flg cnt num )                  
 8        DUP  DIGIT?            \ Check for digit.                
 9        IF   +DIGIT            \ Echo & convert digit, inc count 
10        ELSE DROP BEEP THEN ;  \ Invalid key or overflow.        
11 \ Apply sign to number.                                         
12 : APPLY_SIGN  ( flg cnt num key   num )                         
13        DROP NIP SWAP          \ Drop key, nip cnt, get flg.     
14        IF NEGATE THEN  ; -->  \ Apply sign to number.           
15                                                                 


Screen 16 not modified     
 0 \ Best #IN - protected field, signed input     22:20JWB09/28/85 
 1 : #IN   ( --   num )                    \ flg=sign flag         
 2       FALSE 0 0    ( flg cnt num )      \ cnt=digit count       
 3       BEGIN KEY    ( flg cnt num key )  \ num=# being formed    
 4       DUP ASCII - =                \ Negative number?           
 5       IF EMIT ROT DROP TRUE -ROT   \ Set sign flag true.        
 6          SWAP 1+ SWAP              \ Increment digit count.     
 7       ELSE DUP CONTROL M =         \ Return entered?            
 8            IF APPLY_SIGN  EXIT     \ Apply sign to number & exit
 9            THEN                                                 
10            DUP CONTROL H =         \ Correct error input?       
11            IF   CORRECT.IT         \ This does it.              
12            ELSE PROCESS.IT         \ Process all other keys.    
13            THEN                                                 
14       THEN AGAIN ;                                              
15                                                                 


Screen 17 not modified     
 0 \ REVIEW - 3   Answers to division quiz.       19:55JWB09/26/85 
 1 \ Floored symmetric division.  Note that q and r must satisfy   
 2 \ the equations:   m/n  = q  +  r/n    or  m = nq + r           
 3                                                                 
 4   /     ( m n   q )     Leave q , the floor of real quotient.   
 5   MOD   ( m n   r )     Leave r , remainder (satisfying above). 
 6   /MOD  ( m n   r q )   Leave remainder r and quotient q .      
 7 Quiz:   m    n      r     q       Check:  n * q   +  r  =  m?   
 8       ---   ---    ---   ---             --- ---    ---   ---   
 9        13    5      3     2               5 * 2   +  3  =  13   
10       -11    5      4    -3               5 *-3   +  4  = -11   
11        -2    5      3    -1               5 *-1   +  3  =  -2   
12        13   -5     -2    -3              -5 *-3   + -2  =  13   
13       -11   -5     -1     2              -5 * 2   + -1  = -11   
14        -2   -5     -2     0              -5 * 0   + -2  =  -2   
15 Note:  Remainder takes sign of divisor!!                        


Screen 18 not modified     
 0 \ Problem 4                                    23:13JWB09/28/85 
 1 \ Program the following number guessing game.                   
 2 \ The computer picks a secret number between 1 and 100.  You try
 3 \ to guess the number.  With each guess the computer responds   
 4 \  "WARMER"  if the guess  is closer than the old guess,        
 5 \  "COLDER"  if the guess  is it is not closer,                 
 6 \  "HOT!"    if the guess  is within 2 of the actual number.    
 7 \  "YOU GOT IT" if the guess is correct.                        
 8 \ Hints:  keep game info on the stack    ( secret old#  new# )  
 9 \         Use #IN                                               
10 \         Use the random number generator below.                
11   VARIABLE SEED                                                 
12 : (RND) SEED @ 259 * 3 + 32767 AND DUP SEED ! ;                 
13 : RND  ( n   r )   \ r is a random number   0 <= r < n          
14         (RND) 32767 */ ;                                        
15                                                                 


Screen 19 not modified     
 0 \  Problem 4  Solution.                        10:16JWB09/29/85 
 1 : WINNER? 2 PICK OVER =               ;                         
 2 : HOT?    2 PICK OVER - ABS 3 <       ;                         
 3 : WARMER? 2 PICK OVER - ABS                                     
 4           3 PICK 3 PICK - ABS <       ;                         
 5                                                                 
 6 : GAME                                                          
 7         100 RND 1+ 0                                            
 8         BEGIN CR ." GUESS "  #IN SPACE                          
 9         WINNER?  IF ." GOT IT" DROP 2DROP EXIT THEN             
10         HOT?     IF ." HOT "   ELSE                             
11         WARMER?  IF ." WARMER" ELSE ." COLDER" THEN             
12                  THEN  NIP                                      
13         AGAIN ;                                                 
14 \ Problem:  Modify this program so that it keeps track of the   
15 \ number of guesses required and reports this at the game end.  


Screen 20 not modified     
 0 \ Example 4 Nasty Game.                        10:08JWB09/29/85 
 1 \ A nasty game for the IBM-PC .                                 
 2 : WHITE  177 EMIT ;                                             
 3 : GAME  CR                                                      
 4         CR  ." Press the space bar as hard as you can!"         
 5         BEGIN CR                                                
 6         KEY DROP CR 64 RND 1+                                   
 7         DUP 0 ?DO WHITE LOOP CR                                 
 8         DUP 25 < IF ." Press it harder!!" ELSE                  
 9         DUP 50 < IF ." Not bad! Press real hard!" ELSE          
10         10 0 DO BEEP LOOP                                       
11         DROP ." You just busted your space bar!"                
12         EXIT THEN THEN                                          
13         DROP AGAIN  ;                                           
14 \ Problem:  Expand on this silly game to give more and better   
15 \           responses.                                          


Screen 21 not modified     
 0 \  Return Stack  Example 5  Average            09:54JWB09/29/85 
 1 \  New Words:  >R  R>  and  R@  for accessing the return stack. 
 2 \ These words are very dangerous!! Do NOT test or execute them  
 3 \ interactively. They can only be used within colon definitions.
 4 \ >R  ( n   -- ) Transfer top data stack item to return stack.  
 5 \ R>  ( --   n ) Transfer top return stack item to data stack.  
 6 \ R@  ( --   n ) Copy     top return stack item to data stack.  
 7 \ RULES:                                                        
 8 \ 1. Each use of >R must be balanced with a corresponding R>.   
 9 \ 2. Do not use >R R> and R@ within DO ... LOOPs.  Loop control 
10 \    info is kept on the return stack and could be destroyed.   
11 : AVERAGE  ( x1 x2 ... xn   avg )                               
12       DEPTH >R R@ 1- 0                                          
13         ?DO + LOOP                                              
14         CR ." The average of the " R@ . ." numbers is "         
15         R> / .  CR ;                                            


Screen 22 not modified     
 0 \ Example 6 Histogram, Problems 5 & 6          11:33JWB01/24/86 
 1 \ Problem 5:                                                    
 2 \ Rewrite AVERAGE  so that it takes number pairs, class mark xi 
 3 \ and frequency fi .  ie average = [ sum xi*fi ]/n   n = sum fi 
 4 \ AVERAGE ( x1 f1 x2 f2 ... xk  fk    -- )                      
 5                                                                 
 6 : WHITE  177 EMIT ;                                             
 7                                                                 
 8 \ Given n frequencies construct histogram or bar chart.         
 9 : HISTOGRAM ( f1 f2 ... fn   -- )                               
10         CR DEPTH 0                                              
11         ?DO  CR DUP 0 ?DO WHITE LOOP  SPACE .  LOOP CR ;        
12 \ Problem 6:                                                    
13 \ Modify HISTOGRAM so that the bars come out in the proper order
14 \ ( f1 first). Hint: " ROLL "  the stack and display bar.  Clean
15 \ the stack when finished printing bars.                        


Screen 23 not modified     
 0 \ Example - 7 Square Root                      11:04JWB09/29/85 
 1 \ Square root by Newton's Method.                               
 2 \ Theory:  Let  f(x) = x^2 - n  where the root or zero of this  
 3 \ function is the square root of n.                             
 4 \ Newton's Method:   use guess xo to get better guess xn        
 5 \ according to:   xn = xo - f(xo)/f'(xo)                        
 6 \ It can be shown that:  xn = ( xo + n/xo )/2                   
 7                                                                 
 8 : XNEW  ( n xold   n xnew )                                     
 9         2DUP  /  +  2/  ;                                       
10 : SQRT  ( n    root )                                           
11         DUP 0< IF ABORT" Illegal argument" THEN                 
12         DUP 1 >                                                 
13         IF    DUP 2/  ( n  n/2 ) 10 0 DO XNEW LOOP NIP          
14         THEN  ;                                                 
15 \ Note:  This is not the best or fastest square root algorithm. 


Screen 24 not modified     
 0 \ Example 8 Hypotenuse, Problem 7 Area         19:12jwb09/29/85 
 1 \ Hypotenuse of a right triangle.                               
 2 : HYPO  ( a b   c )                                             
 3         DUP * SWAP                                              
 4         DUP * +                                                 
 5         SQRT  ;                                                 
 6                                                                 
 7 : TEST  15 1 DO  15 1 DO                                        
 8         CR I J 2DUP  4 .R 4 .R  HYPO 4 .R                       
 9         LOOP KEY DROP CR LOOP ;                                 
10                                                                 
11 \ Problem 7: Write a word that calculates the area of a triangle
12 \ using HERO's formula.   A = sqrt[ s(s-a)(s-b)(s-c) ]          
13 \ where  s is the semi perimeter.  s = (a+b+c)/2                
14                                                                 
15                                                                 


Screen 25 not modified     
 0 \ Problem 8 Identify.                          11:27JWB09/29/85 
 1 \ Write the word  IDENTIFY  which takes a key code 0 255 from   
 2 \ the data stack and prints one of the following descriptive    
 3 \ phrases identifying the key code.                             
 4 \ Control character ,  Punctuation character , Lower case letter
 5 \ Upper case letter , Numeric Digit ,  Extended character.      
 6 \ Hint:                                                         
 7 : IDENTIFY ( n   -- )                                           
 8     DUP CONTROL?     IF  ." Control character. "      ELSE      
 9     DUP PUNCTUATION? IF  ." Punctuation character. "  ELSE      
10     DUP DIGIT?       IF  ." Numeric Digit "           ELSE      
11          ...         ..   ...       ....               ...      
12     THEN  THEN ....   THEN  DROP ;   \ One THEN for every IF    
13 : DIGIT?  ( n   flag )  \ Leave true flag if its a digit.       
14      ASCII 0  ASCII 9  [IN]  ;                                  
15 \ Modify IDENTIFY to respond intelligently for  n <0 and n>255 .


Screen 26 not modified     
 0 \ Hard copy screen documentation.              19:58JWB09/26/85 
 1                                                                 
 2 \ Print three screens starting with n on the printer.           
 3 : HTRIAD  ( n   -- )                                            
 4         PRINTING ON DUP 3 +  SWAP (  27 EMIT 69 EMIT )          
 5         DO CR I LIST LOOP  PRINTING OFF ;                       
 6                                                                 
 7 \ Send a top of page command to printer.                        
 8 : FFEED                                                         
 9         PRINTING ON 12 EMIT PRINTING OFF ;                      
10                                                                 
11 \ Print screens  first through last  on printer, three per page.
12 : DOC   ( first last   -- )                                     
13         1+ SWAP DO I HTRIAD FFEED 3 +LOOP ;                     
14                                                                 
15                                                                 


Screen 27 not modified     
 0 \ Solution to problem 5                        19:10jwb09/29/85 
 1 : AVERAGE  ( x1 f1 x2 f2 ... xn fn    -- )                      
 2         0 0 DEPTH  2/ 1-  0                                     
 3         ?DO  2 PICK +                                           
 4              2SWAP *                                            
 5              ROT  +  SWAP                                       
 6         LOOP                                                    
 7         CR ." The average of the "                              
 8         DUP .   ." numbers is "  / . CR ;                       
 9                                                                 
10                                                                 
11 \                                                               
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 28 not modified     
 0 \ Binary, decimal and hexadecimal number display.               
 1 \ The radix of the FORTH system is the number base with which   
 2 \ all arithmetic is performed.                                  
 3   HEX                 \ Set system radix to base 16             
 4   DECIMAL             \ Set system radix to base 10             
 5 : BINARY 2 BASE ! ;   \ Set system radix to base  2             
 6                                                                 
 7 : .B  BINARY  0 <# # # # # # # # # # # # # # # # # #>           
 8       TYPE SPACE  DECIMAL ;                                     
 9 : .H  HEX     4 U.R SPACE   DECIMAL ;                           
10 : .D  DECIMAL 6 U.R SPACE           ;                           
11                                                                 
12 : TABLE ( n  -- )                                               
13     CR ." DEC  HEX     BINARY"                                  
14    1+ 0  ?DO CR I 4 .R  I .H  I .B LOOP ;                       
15                                                                 
projects/sample3.blk.txt · Zuletzt geändert: 2013-06-06 21:27 (Externe Bearbeitung)