🚀 go-pugleaf

From responsen on the net seems that I better post that for a wider
audience.  Here are excerpts from an article which I wrote for a
newsletter of a users' group.  It just happened that I tried to show
some methods of vectored execution and how to perform recursive calls,
a little bit more involved than allowed with MYSELF or RECURSE.

I know that the code, which you will find below, can be compacted.  But
idea was to make it run fast for an expense of some repetitve coding.

The code is written in TI-Forth which is an extension of fig-Forth. If
you will find somethng strange there - this is probably a graphics
support word, so do not pay big attention.  SRC is ShiftRightCyclicaly
by a number of bits taken from stack.  Please pay attentin that on
79-Standard and 83-Standard systems EXECUTE prefers compilation address
over 'CFA'. 

If you have a DOT - turns on pixel on screen in a given location,
what else - convert and have fun.
----------------------
    ...[Here} a  method  of  choice  is a vectored execution -
consult  "Starting Forth " by Leo Brodie - and defered execution
words,  as  described,  more  or  less, by Henry Laxen in "Forth
Dimensions",  Vol. III, no. 6. Here is a TI-Forth version. DEFER
is defining word introduced as follows:


  : DEFER    <BUILDS ' NOP CFA , DOES> @ EXECUTE ;

You  may  use  it to define DEFER HELLO and HELLO, when executed
will  just  do  nothing,  or  more precisely will execute a word
which  CFA  is stored under address returned by ' HELLO - namely
NOP.   A convenient way to change a behavior of HELLO is to us a
word IS.

  : IS CFA [COMPILE] ' ! ;

Now  define  :  HI  ." How are you, pal!" CR ;, : BYE ." See you
later!" CR ; and you may try to type

  ' HI   IS HELLO    HELLO
  ' BYE  IS HELLO    HELLO

    One thing to remember.  Due to a way in which ' operates IS
will give you expected results only when in interpretation mode.
If  you  wold  like  to  change  an  operation of HELLO inside a
defintion,  just  stick  a  proper CFA into PFA of HELLO.  It ia
possible to rewrite IS to make it "state-smart" but probably not
worth to bother.

    Back  to  recursion. You simply define DEFERed stubs to use
inside  recursive words.  After definitions are complete you are
using  IS  to redefine stubs into what you just defined.  Voila!
Instant  self-reference  of  any  degree  of  complication.  See
screens for an example of usage.


----------------------------------------------------------------

( Dragon curve * 1st scrn * Michal Jaegermann  1MAY86 )
BASE @ HEX  
40 VARIABLE STEP  \ SEGx draws segment and updates position
: SEG0   STEP @ 0 DO OVER OVER DOT    >R 1+ R> LOOP ;
: SEG1   STEP @ 0 DO OVER OVER DOT 1- >R 1+ R> LOOP ;
: SEG2   STEP @ 0 DO OVER OVER DOT 1-          LOOP ;
: SEG3   STEP @ 0 DO OVER OVER DOT 1- >R 1- R> LOOP ;
: SEG4   STEP @ 0 DO OVER OVER DOT    >R 1- R> LOOP ;
: SEG5   STEP @ 0 DO OVER OVER DOT 1+ >R 1- R> LOOP ;
: SEG6   STEP @ 0 DO OVER OVER DOT 1+          LOOP ;
: SEG7   STEP @ 0 DO OVER OVER DOT 1+ >R 1+ R> LOOP ;

' SEG0 CFA
   VARIABLE EVENHD   ' SEG2 CFA , ' SEG4 CFA , ' SEG6 CFA ,
' SEG1 CFA
   VARIABLE  ODDHD   ' SEG3 CFA , ' SEG5 CFA , ' SEG7 CFA , -->

( Dragon curve * 2nd scrn * Michal Jaegermann  1MAY86 )
0 VARIABLE SEGTBLE
0 VARIABLE HEADING  0 VARIABLE XCOR  0 VARIABLE YCOR
: SEGMENT ( x y -- x1 y1 ) \ vectored through SEGTBLE
    HEADING @ 06 AND SEGTBLE @ + @ EXECUTE  ;

DEFER <LDRAGON>   DEFER <RDRAGON>

: LDRAGON ( n -- n-1 or draw )
    -DUP IF 1- DUP <LDRAGON>  2 HEADING +! <RDRAGON>
         ELSE XCOR @ YCOR @ SEGMENT YCOR ! XCOR ! ENDIF ;
: RDRAGON ( n -- n-1 or draw )
    -DUP IF 1- DUP <LDRAGON> -2 HEADING +! <RDRAGON>
         ELSE XCOR @ YCOR @ SEGMENT YCOR ! XCOR ! ENDIF ;

' LDRAGON IS <LDRAGON>   ' RDRAGON IS <RDRAGON>          -->

( Dragon curve * 3rd scrn * Michal Jaegermann  1MAY86 )

: SETUP ( level -- level) 0 MAX 0E MIN
  DUP 1 AND IF ODDHD ELSE EVENHD ENDIF SEGTBLE !
  DUP MINUS HEADING ! 80 OVER 1+ 2 / SRC STEP !
  48 XCOR   ! 50 YCOR !
  F0 DCOLOR ! GRAPHICS2  07 7 VWTR  DRAW ;

: DRAGON ( level -- )  SETUP LDRAGON ;

: DRAGONS 0F 0 DO I DRAGON KEY  \ 'break' has a scan code 02
       2 = IF LEAVE ENDIF LOOP TEXT ;

BASE !

----------------------------------------------------------------
Michal Jaegermann
Myrias Research Corporation
Edmonton. Alberta, CANADA
...ihnp4!alberta!myrias!mj