Benutzer-Werkzeuge

Webseiten-Werkzeuge


projects:poly.blk

Polynomial properties application

Screen 0 not modified     
 0                                                                 
 1 \ Last change:   Screen  019                   13:55JWB04/15/87 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 



Screen 2 not modified     
 0 EXIT  Distance between two points.                              
 1                                                                 
 2 Y                                                               
 3 |           p2            p1 = ( x1,y1 )                        
 4 |          /|             p2 = ( x2,y2 )                        
 5 |         / |                                                   
 6 |     d  /  |             b   = y2 - y1                         
 7 |       /   | b           a   = x2 - x1                         
 8 |      /    |                                                   
 9 |     /  a  |             d  = [(x2-x1)^2 + (y2-y1)^2]^.5       
10 | p1 --------                                                   
11 |----------------X                                              
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 3 not modified     
 0 EXIT  Area of a polygon.                                        
 1                                                                 
 2     p1 /---------\  p2        p1 = ( x1,y1 )                    
 3       /           \           p2 = ( x2,y2 )                    
 4      /             \  p3      p3 = ( x3,y3 )                    
 5     /              /          p4 = ( x4,y4 )                    
 6 p5 /--------------/ p4        p5 = ( x5,y5 )                    
 7                                                                 
 8 AREA OF THE POLYGON =                                           
 9 [(x1y5-x5y1)+(x2y1-x1y2)+(x3y2-x2y3)+(x4y3-x3y4)+(x5y4-x4y5)]/2 
10                                                                 
11 In general:                                                     
12            i=n                                                  
13 AREA = 0.5*SUM [ x(i)y(i-1) - x(i-1)y(i) ]                      
14            i=1                                                  
15  where we define x0 to be x5 and y0 to be y5.                   


Screen 4 not modified     
 0 EXIT   Sample Calculation.                                      
 1                                                                 
 2   X   Not drawn to scale!!                                      
 3   |                              p1 = ( 8,4 )                   
 4   |                              p2 = ( 6,1 )                   
 5   |    p4 ----------- p1         p3 = ( 2,1 )                   
 6   |      /          /            p4 = ( 5,4 )                   
 7   |     /          /                                            
 8   |    /          /                                             
 9   | p3 -----------  p2                                          
10   |-----------------------Y                                     
11                                                                 
12 A = [(8*4-5*4)+(6*4-8*1)+(2*1-6*1)+(5*1-2*4)]/2 = 10.5          
13                                                                 
14                                                                 
15                                                                 


Screen 5 not modified     
 0 \ Polygon Area - 1                             05:07jwb10/07/85 
 1 : #IN ( --  n )                                                 
 2       QUERY  INTERPRET ;                                        
 3 CREATE X  102 ALLOT     \ Array for x coordinates               
 4 CREATE Y  102 ALLOT     \ Array for y coordinates               
 5 VARIABLE  #POINTS       \ Number of points in polygon           
 6 VARIABLE  AREA          \ Sum of the x(i)y(i-1) - x(i)y(i+1)    
 7 \ Fetch ith x component.                                        
 8 : X@  ( i     x{i} ) 2* X + @ ;                                 
 9 \ Fetch ith y component.                                        
10 : Y@  ( i     y{i} ) 2* Y + @ ;                                 
11 \ Store ith x component.                                        
12 : X!  ( x i     -- ) 2* X + ! ;                                 
13 \ Store ith y component.                                        
14 : Y!  ( y i     -- ) 2* Y + ! ;                                 
15                                                                 


Screen 6 not modified     
 0 \ Polygon area - 2                             21:11jwb10/06/85 
 1 \ Move to the next tab stop.                                    
 2 : TAB ( --  -- )                                                
 3          BEGIN  #OUT @ 8 MOD                                    
 4                IF SPACE ELSE EXIT THEN                          
 5         AGAIN ;                                                 
 6 \ Get number from keyboard.                                     
 7 : GET#  ( --   n )                                              
 8          ASCII >  EMIT SPACE  #IN ;                             
 9 \ Prompt and fetch number of data points.                       
10 : GET_#POINTS  ( --   -- )                                      
11         BEGIN                                                   
12         CR ." Enter number of data points. "                    
13         GET#  DUP 3 <                                           
14         WHILE  CR ." You need at least 3 data points!"          
15         REPEAT  50 MIN #POINTS ! ;                              


Screen 7 not modified     
 0 \ Polygon area - 3                             21:12jwb10/06/85 
 1 \ Prompt and fetch all data points.                             
 2 : GET_DATA      ( --   -- )                                     
 3         CR CR ." Point " TAB ."   X" TAB ."   Y"                
 4         #POINTS @ 1+ 1                                          
 5         DO   CR I 3 .R  TAB GET# I X!                           
 6              TAB GET# I Y! LOOP                                 
 7         #POINTS @ DUP X@ 0 X! Y@ 0 Y! ;                         
 8 \ Sum data points.                                              
 9 : FIND_AREA   ( --   -- )                                       
10         0 AREA !                                                
11         #POINTS @ 1+  1         ( n+1 so we loop n times )      
12         DO I    X@ I 1- Y@ *    ( X{i}*Y{i-1} )                 
13            I 1- X@ I    Y@ *    ( X{i-1}*Y{i} )                 
14            - AREA +!                                            
15         LOOP  ;                                                 


Screen 8 not modified     
 0 \ Polygon area - 4                             20:55jwb10/06/85 
 1 \ Display computed area.                                        
 2 : PUT_AREA      ( --  -- )                                      
 3         AREA @ 2 /MOD                                           
 4         CR ." AREA = " 6 .R  ASCII . EMIT                       
 5         IF ASCII 5 EMIT ELSE ASCII 0 EMIT THEN SPACE ;          
 6                                                                 
 7 \ Compute area of polygon.                                      
 8 : POLY     ( --   -- )                                          
 9         GET_#POINTS                                             
10         GET_DATA                                                
11         FIND_AREA                                               
12         PUT_AREA ;                                              
13                                                                 
14                                                                 
15                                                                 


Screen 9 not modified     
 0 \ Load screen for enhanced POLY program.                        
 1                                                                 
 2   FORGET PTASK                                                  
 3                                                                 
 4 : PTASK ;                                                       
 5                                                                 
 6                                                                 
 7   10 19 THRU                                                    
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 10 not modified     
 0 \  32 bit square root KS  4TH DIM V4N1P9                        
 1                                                                 
 2 : EASY-BITS ( drem1 partial.root1 count   drem2  partial.root2 )
 3     0  DO  >R  D2*  D2*                                         
 4            R@  -  DUP  0<                                       
 5            IF    R@ + R> 2*  1-                                 
 6            ELSE       R> 2*  3  +                               
 7            THEN  LOOP  ;                                        
 8                                                                 
 9 : 2'S-BIT ( drem2 proot2   drem3  proot3 ) \ get penultimate bit
10      >R  D2*  DUP  0<                                           
11      IF   D2*  R@  -  R>  1+                                    
12      ELSE D2*  R@  2DUP  U<                                     
13           IF   DROP  R> 1-                                      
14           ELSE  -    R> 1+                                      
15      THEN THEN ;                                                


Screen 11 not modified     
 0 \  32 bit square root KS  4TH DIM V4N1P9                        
 1 : 1'S-BIT   ( drem3 proot3   fullroot )  \ remainder lost       
 2      >R  DUP  0<                                                
 3      IF    2DROP  R>  1+                                        
 4      ELSE  D2*  32768 R@  DU<  0=  R>  THEN ;                   
 5                                                                 
 6 \ 32-bit unsigned radicand to 16-bit unsigned square root       
 7 : SQRT     ( ud     u  )                                        
 8         0  1 8 EASY-BITS  ROT  DROP  6 EASY-BITS                
 9         2'S-BIT  1'S-BIT  ;                                     
10                                                                 
11 \ Display 16-bit number with two decimal places.                
12 : I.XX  ( 100*n   -- )                                          
13          0 <#  # #  ASCII . HOLD  #S #>                         
14         TYPE  SPACE ;                                           
15                                                                 


Screen 12 not modified     
 0 \ Support for bullet proof #IN                 05:31jwb10/07/85 
 1 : BELL    ( --   -- )  7 EMIT -1 #OUT +! ;                      
 2 : DIGIT?  ( n    flag )    \ Leave true flag if valid digit.    
 3         DUP 47 > SWAP 58 < AND ;                                
 4 : RUBOUT  ( --   -- )       \ Rub out most recent digit         
 5         8 EMIT 32 EMIT 8 EMIT -4 #OUT +! ;                      
 6 \ Remove digit from screen and number then dec digit count.     
 7 : -DIGIT  ( cnt n    cnt-1 n/10 )                               
 8         RUBOUT SWAP 1- SWAP 10 / ;                              
 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 BELL                             
13         ELSE DROP SWAP EMIT SWAP 1+ SWAP THEN ;                 
14 : RESET?   ( flg cnt n   ff cnt n )   \  Reset sign flag.       
15       OVER 0= IF  ROT DROP FALSE -ROT THEN ;                    


Screen 13 not modified     
 0 \ Support for bullet proof #IN                 05:31jwb10/07/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 BELL THEN RESET? ; \ 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 BELL 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 : NEGATIVE? ASCII - =  3 PICK 0= AND ;     \ Negative number?   


Screen 14 not modified     
 0 \ Bullet proof #IN                             21:08JWB10/02/85 
 1 : SET-FLAG  ( flg cnt num key   flg cnt num )                   
 2       EMIT ROT DROP TRUE -ROT   \ Set sign flag true.           
 3       SWAP 1+ SWAP  ;           \ Increment digit count.        
 4 : #IN   ( --   num )                    \ flg=sign flag         
 5       FALSE 0 0    ( flg cnt num )      \ cnt=digit count       
 6       BEGIN KEY    ( flg cnt num key )  \ num=# being formed    
 7       DUP  NEGATIVE?               \ Negative number?           
 8       IF   SET-FLAG                \ Set -VE  flag true.        
 9       ELSE DUP CONTROL M =         \ Return entered?            
10            IF APPLY-SIGN EXIT THEN \ Apply sign to number & exit
11            DUP CONTROL H =         \ Correct error input?       
12            IF   CORRECT.IT         \ This does it.              
13            ELSE PROCESS.IT  THEN   \ Process all other keys.    
14       THEN AGAIN ;                                              
15 \ : TEST BEGIN CR #IN 3 SPACES DUP . 0= UNTIL ;                 


Screen 15 not modified     
 0 \ Polygon Area & Perimeter                     13:53JWB04/15/87 
 1 CREATE X  102 ALLOT     \ Array for x coordinates               
 2 CREATE Y  102 ALLOT     \ Array for y coordinates               
 3 VARIABLE  #POINTS       \ Number of points in polygon           
 4 VARIABLE  AREA          \ Sum of the x(i)y(i-1) - x(i)y(i+1)    
 5 VARIABLE  PERIMETER  \ Sum of [{x(i)-x(i-1)}^2+{y(i)-y(i-1)}]^.5
 6                                                                 
 7 \ Fetch ith x component.                                        
 8 : X@  ( i     x{i} ) 2* X + @ ;                                 
 9 \ Fetch ith y component.                                        
10 : Y@  ( i     y{i} ) 2* Y + @ ;                                 
11 \ Store ith x component.                                        
12 : X!  ( x i     -- ) 2* X + ! ;                                 
13 \ Store ith y component.                                        
14 : Y!  ( y i     -- ) 2* Y + ! ;                                 
15                                                                 


Screen 16 not modified     
 0 \ Polygon Area & Perimeter - 2                 13:54JWB04/15/87 
 1 \ Move to the next tab stop.                                    
 2 : TAB ( --  -- )                                                
 3          BEGIN  #OUT @ 8 MOD                                    
 4                IF SPACE ELSE EXIT THEN                          
 5         AGAIN ;                                                 
 6 \ Get number from keyboard.                                     
 7 : GET#  ( --   n )                                              
 8          ASCII >  EMIT SPACE  #IN ;                             
 9 \ Prompt and fetch number of data points.                       
10 : GET_#POINTS  ( --   -- )                                      
11         BEGIN                                                   
12         CR ." Enter number of data points. "                    
13         GET#  DUP 3 <                                           
14         WHILE  CR ." You need at least 3 data points!"          
15         REPEAT  50 MIN #POINTS ! ;                              


Screen 17 not modified     
 0 \ Polygon Area & Perimeter -3                  13:54JWB04/15/87 
 1 \ Prompt and fetch all data points.                             
 2 : GET_DATA      ( --   -- )                                     
 3         CR CR ." Point " TAB ."   X" TAB ."   Y"                
 4         #POINTS @ 1+ 1                                          
 5         DO   CR I 3 .R  TAB GET# I X!                           
 6              TAB GET# I Y! LOOP                                 
 7         #POINTS @ DUP X@ 0 X! Y@ 0 Y! ;                         
 8 \ Sum data points.                                              
 9 : FIND_AREA   ( --   -- )                                       
10         0 AREA !                                                
11         #POINTS @ 1+  1         ( n+1 so we loop n times )      
12         DO I    X@ I 1- Y@ *    ( X{i}*Y{i-1} )                 
13            I 1- X@ I    Y@ *    ( X{i-1}*Y{i} )                 
14            - AREA +!                                            
15         LOOP  ;                                                 


Screen 18 not modified     
 0 \ Polygon Area & Perimeter - 4                 13:54JWB04/15/87 
 1                                                                 
 2 : DIST  ( x2 y2 x1 y1   100*d )                                 
 3         ROT - DUP *          \ x2 x1  (y1-y2)^2                 
 4        -ROT - DUP *          \ (y1-y2)^2 (x2-x1)^2              
 5         + 10000 UM* SQRT  ;  \ 100*d                            
 6                                                                 
 7 : FIND_PERIMETER ( --  -- )                                     
 8         0 PERIMETER !                                           
 9         #POINTS @ 1+ 1                                          
10         DO   I    X@  I    Y@                                   
11              I 1- X@  I 1- Y@                                   
12              DIST  PERIMETER +!                                 
13         LOOP ;                                                  
14                                                                 
15                                                                 


Screen 19 not modified     
 0 \ Polygon Area & Perimeter - 6                 13:55JWB04/15/87 
 1 \ Display computed area.                                        
 2 : PUT_AREA      ( --  -- )                                      
 3         AREA @ 2 /MOD                                           
 4         CR ." AREA = " 6 .R  ASCII . EMIT                       
 5         IF ASCII 5 EMIT ELSE ASCII 0 EMIT THEN SPACE ;          
 6 \ Display computed perimeter.                                   
 7 : PUT_PERIMETER ( --  -- )                                      
 8         CR ." PERIMETER = "                                     
 9         PERIMETER @ I.XX ;                                      
10                                                                 
11 \ Compute area of polygon.                                      
12 : POLY     ( --   -- )                                          
13         GET_#POINTS GET_DATA                                    
14         FIND_AREA   FIND_PERIMETER                              
15         PUT_AREA    PUT_PERIMETER ;                             
projects/poly.blk.txt · Zuletzt geändert: 2013-06-06 21:27 (Externe Bearbeitung)