Path: csiph.com!eternal-september.org!feeder.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: Paul Rubin <no.email@nospam.invalid>
Newsgroups: comp.lang.forth
Subject: Re: Yet another draw of rectangle
Date: Tue, 22 Nov 2016 00:02:58 -0800
Organization: A noiseless patient Spider
Lines: 36
Message-ID: <87r3649c25.fsf@nightsong.com>
References: <e53e58f1-c90c-4d95-9dec-9ff6d6ac1169@googlegroups.com> <o0r6b9$e07$1@gioia.aioe.org> <6755c77f-2dd0-43cc-af59-91ea3449dbbc@googlegroups.com> <o0rv3a$1avt$1@gioia.aioe.org> <14a2bc75-d574-4103-b6fa-5ff0fedfc63a@googlegroups.com> <o0tcfn$1mju$1@gioia.aioe.org> <87polpbrw3.fsf@nightsong.com> <o0tsml$7cu$1@gioia.aioe.org>
Mime-Version: 1.0
Content-Type: text/plain
Injection-Info: mx02.eternal-september.org; posting-host="5760eee8d93fd47410dfe7d011dcbe8a"; logging-data="5641"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX19leQ5UYkiEanhRUfc9v/JA"
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux)
Cancel-Lock: sha1:YXoSMJsued7PfJoPtHcNJ45LzNo= sha1:3Lj7N2QcmLswkrm4lOuNyJ5mYvA=
Xref: csiph.com comp.lang.forth:52806

"HAA" <someone@microsoft.com> writes:
> MOVETO ( x y -- ) is a general-purpose function in the graphics
> package and requires the 2DUP here.  I think you have hit on the
> definitive Forth definition for RECT.  My original was 14
> instructions, yours would make it 11.

Heh, I'm sure others have done it better.  And the LINE version is still
a pretty annoying challenge.  I wrote a "brute force" version with the
idea of refactoring it for fewer operations after writing it; but
getting it working was time consuming and tiring enough that I put it
aside after it worked:

    : 4dup 2over 2over  ;

    : LINE ( x0 y0 x1 y1 -- ) 2>r swap . . 2r> swap . . cr ;

    \ & in stack comment means duplicate the input parameters
    : r1 ( x0 y0 x1 y1 -- & x0 y0 x1 y0 ) 4dup drop over ;

    : r2 ( x0 y0 x1 y1 -- &  x1 y0 x1 y1 )
        4dup  >r -rot nip over r> ;

    : r3 ( x0 y0 x1 y1 -- & x1 y1 x1 y0 )
        4dup 2swap drop over ;

    : r4 ( x0 y0 x1 y1 -- x0 y1 x0 y0 )
        nip ( x0 y0 y1 )
        >r over r> ( x0 y0 x0 y1 )
        -rot swap ;

    : rect r1 LINE r2 LINE r3 LINE r4 LINE ;

    : test cr clearstack 0 10 1 11 rect ;

Is this really the language we want to entice schoolkids into
programming with?!  :)