home *** CD-ROM | disk | FTP | other *** search
/ Antic Magazine 1982 October / Antic_October_1982_Vol_1_No_4.atr / fort1182.txt < prev    next >
Text File  |  2021-02-14  |  7KB  |  1 lines

  1. (    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¢¢