home *** CD-ROM | disk | FTP | other *** search
- ( Turtle Graphics II, screen 1 )¢DECIMAL¢: VALUES¢ <BUILDS 0 DO¢ 0 , LOOP¢ DOES> OVER + +¢ TO-FLAG @ IF¢ 0 TO-FLAG ! ! ELSE¢ @ THEN ;¢VALUE PREFIX¢: SET ( --- ) 2 TO PREFIX ;¢: SHOW ( --- ) 4 TO PREFIX ;¢: ROOT: ( --- )¢ <BUILDS SMUDGE ]¢ DOES> PREFIX + @ EXECUTE¢ 0 TO PREFIX :¢-->¢¢( Turtle Graphics II, screen 2 )¢4 CONSTANT #TURTLES¢VALUE WHICH¢ ( The number of the active turtle )¢: ACTIVE! ( n --- ) TO WHICH ;¢: .WHICH ( --- )¢ ." Turtle #" WHICH . ;¢ : ACTIVE? ( --- )¢ .WHICH ." is active " CR ;¢ROOT: ACTIVE WHICH ACTIVE! ACTIVE? ;¢-->¢¢( Turtle Graphics II, screen 3 )¢: MODE@ ( --- n ) 87 C@ ;¢: MODE? ( --- )¢ ." This is graphics mode"¢ MODE@ . CR ;¢TABLE MAX_COL# ( n1 --- n2 )¢ 39 , 19 , 19 , 39 , 79 , 79 , 159 , 159 , 319 ,¢TABLE MAX_ROM# ( n1 --- n2 )¢ 19 , 19 , 9 , 19 , 39 , 39 , 79 , 159 ,¢: WHOLE-SCREEN ( --- n1 n2 n3 n4 )¢ 1 MODE@ MAX_COL# 1-¢ 1 MODE@ MAX_ROW# 1- ;¢-->¢¢( 44 Turtle Graphics II, screen 4 )¢: VIEWPORT@ ( --- n1 n2 n3 n4 )¢ CLIPPING LEFT RIGHT TOP BOTTOM ;¢: VIEWPORT? ( --- ) CLIPPING¢ ." The viewport is from column "¢ LEFT . ." to " CR ." column "¢ RIGHT . ." and from now " TOP .¢ ." to row " BOTTOM . CR ;¢VALUE XMIN VALUE YMIN¢VALUE XMAX VALUE YMAX¢: WINDOW@ ( --- n1 n2 n3 n4 )¢ XMIN XMAX YMIN YMAX ;¢: WINDOW? ( --- )¢ ." The window is from x=" XMIN .¢ ." to X=" XMAX . CR ." and from Y="¢ YMIN . ." to Y=" YMAX . CR ;¢-->¢¢¢( Turtle Graphics II, screen 5 )¢VALUE 0COL VALUE 0ROW¢: ORIGIN! ( --- ) CLIPPING¢ XMIN MINUS RIGHT LEFT -¢ XMAX XMIN - */ LEFT + TO 0COL¢ YMAX MINUS TOP BOTTOM -¢ YMAX YMIN - */ TOP + TO 0ROW ;¢: VIEWPORT! ( n1 n2 n3 n4 --- )¢ CLIPPING¢ MODE@ MAX_ROW# MIN TO BOTTOM¢ 0 MAX TO TOP¢ MODE@ MAX_COL# MIN TO RIGHT¢ 0 MAX TO LEFT¢ ORIGIN! ;¢: WINDOW! ( n1 n2 n3 n4 --- )¢ TO YMAX TO YMIN TO XMAX TO XMIN¢ ORIGIN! ;¢-->¢¢( Turtle Graphics II, screen 6 )¢ROOT: VIEWPORT¢ VIEWPORT@ VIEWPORT! VIEWPORT? ;¢ROOT: WINDOW¢ WINDOW@ WINDOW! WINDOW? ;¢: LEFT- ( --- n )¢ CLIPPING LEFT 1- 0 MAX ;¢: TOP- ( --- n )¢ CLIPPING TOP 1- 0 MAX ;¢: RIGHT+ ( --- n ) CLIPPING¢ RIGHT 1+ MODE@ MAX_COL# MIN ;¢: BOTTOM+ ( --- n ) CLIPPING¢ BOTTOM 1+ MODE@ MAX_ROW# MIN ;¢: FRAME ( n --- ) COLOR¢ LEFT- TOP- PLOT¢ RIGHT+ TOP- DRAWTO¢ RIGHT+ BOTTOM+ DRAWTO¢ LEFT- BOTTOM+ DRAWTO¢ LEFT- TOP- DRAWTO ;¢-->¢¢( Turtle Graphics II, screen 7 )¢#TURTLES VALUES PEN()¢: PEN@ ( --- flag ) WHICH PEN() ;¢: PENDOWN? ( --- flag ) PEN@ ;¢: PENUP? ( --- flag ) PEN@ 0= ;¢: PEN! ( flag --- )¢ 0= 0= WHICH TO PEN() ;¢: PENDOWN ( --- ) 1 PEN! ;¢: PENUP ( --- ) 0 PEN! ;¢: PEN? ( --- ) .WHICH¢ ." has her pen " PEN@ IF¢ ." down " ELSE¢ ." up " THEN¢ CR ;¢ROOT: PEN PEN@ PEN! PEN? ;¢-->¢¢( Turtle Graphics II, screen 8 )¢#TURTLE VALUES INK()¢: INK@ ( --- n ) WHICH INK() ;¢: INK! ( n --- ) WHICH TO INK() ;¢: ERASING ( --- ) 0 INK! :¢: INK? ( --- )¢ .WHICH ." is using ink #" INK@ . CR ;¢ROOT: INK INK@ INK! INK? ;¢-->¢¢( Turtle Graphics II, screen 9 )¢#TURTLES VALUES HEADING()¢: HEADING@ ( --- n )¢ WHICH HEADING() ;¢: HEADING? ( --- ) .WHICH¢ ." has heading " HEADING@ . CR ;¢: HEADING! ( n --- )¢ 360 MOD WHICH TO HEADING() ;¢: TURNTO ( n --- ) HEADING! ;¢ROOT: HEADING¢ HEADING@ HEADING! HEADING? ;¢: TURN ( n --- )¢ HEADING@ + HEADING! ;¢: RIGHT ( n --- ) TURN ;¢: LEFT ( n --- ) MINUS TURN ;¢-->¢¢( Turtle Graphics II, screen 10 )¢#TURTLES VALUES X()¢#TURTLES VALUES Y()¢: X@ ( --- n ) WHICH X() ;¢: Y@ ( --- n ) WHICH Y() ;¢: X? ( --- )¢ .WHICH ." is at X=" X@ . CR ;¢: Y? ( --- )¢ .WHICH ." is at Y=" Y@ . CR ;¢: POSITION@ ( --- n1 n2 ) X@ Y@ ;¢: POSITION? ( --- ) .WHICH¢ ." is at X=" X@ . ." and Y=" Y@ . CR ;¢-->¢¢( Turtle Graphics II, screen 11 )¢: X->COL ( n1 --- n2 ) CLIPPING¢ RIGHT LEFT - XMAX XMIN - */ 0COL + ;¢: Y->ROW ( n1 --- n2 ) CLIPPING¢ TOP BOTTOM - YMAX YMIN - */ 0ROW + ;¢: SCALE ( n1 n2 --- n3 n4 )¢ SWAP X->COL SWAP Y->ROW ;¢: ?CONSOLE ( --- flag )¢ 53279 C@ 7 = NOT ;¢: POSITION! ( n1 n2 --- )¢ ?CONSOLE IF¢ SP! CR ." ok" QUIT THEN¢ PEN@ IF¢ INK@ COLOR¢ OVER OVER SCALE POSITION@ SCALE¢ LINE THEN¢ WHICH TO Y() WHICH TO X() ;¢-->¢¢( Turtle Graphics II, screen 12 )¢: GOTO ( n1 n2 --- ) POSITION! ;¢ROOT: POSITION¢ POSITION@ POSITION! POSITION? ;¢: X! ( n --- ) Y@ POSITION! ;¢: Y! ( n --- ) X@ SWAP POSITION! ;¢ROOT: X X@ X! X? ;¢ROOT: Y Y@ Y! Y? ;¢: MOVETO ( n1 n2 --- )¢ PEN@ ROT ROT PENUP POSITION! PEN! ;¢: DRAWTO ( n1 n2 --- )¢ PEN@ ROT ROT PENDOWN POSITION! PEN! ;¢ -->¢¢¢( Turtle Graphics II, screen 13 )¢VALUE SIZE_N VALUE SIZE_D¢: SIZE@ ( --- n1 n2 )¢ SIZE_N SIZE_D ;¢: SIZE* ( n1 --- n2 ) SIZE@ */ ;¢: SIZE! ( n1 n2 --- )¢ TO SIZE_D TO SIZE_N ;¢: SIZE? ( --- )¢ SIZE_D DUP . 1 = IF¢ ." step is " ELSE¢ ." steps are " THEN¢ ." a distance of " SIZE_N . CR ;¢ROOT: SIZE SIZE@ SIZE! SIZE? ;¢-->¢¢¢( Turtle Graphics II, screen 14 )¢: VECTOR ( n --- n1 n2 )¢ DUP HEADING@ SIN* X@ +¢ SWAP HEADING@ COS* Y@ + ;¢: FORWARD ( n --- )¢ SIZE* VECTOR POSITION! ;¢: BACKGROUND ( n --- ) MINUS FORWARD ;¢: MOVE ( n --- )¢ PEN@ SWAP PENUP FORWARD PEN! ;¢: DRAW ( n --- )¢ PEN@ SWAP PENDOWN FORWARD PEN! ;¢-->¢¢¢( Turtle Graphics II, screen 15 )¢: PER-PIXEL ( n --- )¢ CLIPPING >R¢ RIGHT LEFT - 2 /¢ DUP MINUS R * SWAP 1+ R *¢ BOTTOM TOP - 2 /¢ DUP MINUS R * SWAP 1+ R *¢ SET WINDOW R> 1 SET SIZE ;¢( Make SURE you typed the >R and R> )¢( in this correctly. )¢: SCREEN-DEFAULTS ( --- )¢ WHOLE-SCREEN SET VIEWPORT¢ 100 PER-PIXEL ;¢TABLE GR.BYTES ( n1 --- n2 )¢ 960 , 400 , 200 , 200 , 400 ,¢ 800 , 1600 , 3200 , 6400 ,¢: CLEAR ( --- )¢ 88 @ MODE@ GR.BYTES ERASE ;¢-->¢¢¢( Turtle Graphics II, screen 16 )¢: HOME ( --- )¢ 0 0 MOVETO 0 TURNTO PENDOWN ;¢: START ( --- )¢ #TURTLES 0 DO¢ I SET ACTIVE HOME¢ MODE@ 2 MOD IF¢ I ELSE I 0= 0= THEN¢ SET INK LOOP¢ 1 SET ACTIVE ;¢: MODE! ( n --- )¢ GRAPHICS SCREEN-DEFAULTS¢ 1 FRAME START ;¢ROOT: MODE MODE@ MODE! MODE? ;¢: NEW ( --- ) CLEAR 1 FRAME START ;¢: BYE ( --- ) 0 GRAPHICS¢ 0 710 C! 68 712 C! ;¢-->¢¢¢( Turtles Graphics II, screen 17 )¢: DEFINE [COMPILE] : : IMMEDIATE¢: AS ; IMMEDIATE¢: END [COMPILE] ; ; IMMDEIATE¢: \ ( ignores rest of line )¢ IN @ C\L / 1+ C/L * IN ! ; IMMEDIATE¢: (¢ COMPILE 0 [COMPILE] DO ; IMMEDIATE¢: ) [COMPILE] LOOP ; IMMEDIATE¢: +) [COMPILE] +LOOP ; IMMEDIATE¢:S¢¢
