INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
• Talk With Other Members
• Be Notified Of Responses
• Keyword Search
Favorite Forums
• Automated Signatures
• Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

#### Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

# Shape printing

## Shape printing

(OP)
I'm learning Forth, coming from a background in ALGOL derivatives such as C, C++ and the like. I'm doing a common beginner's exercise that consists of printing the following shapes:

*
***
*****
*******
*********

*
* *
*   *
*     *
*       *

*
***
*****
*******
*********
*******
*****
***
*

#### CODE

*
* *
*   *
*     *
*       *
*     *
*   *
* *
*
Here's my first working solution. I was hoping that somebody more familiar with the language could comment on my code and possibly suggest ways to improve it.

#### CODE

: CALC-SPACES  ( nl ni -- nspaces )
SWAP DUP 1- ROT -
;

: CALC-STARS  ( nl ni -- nstars )
2* 1-
;

: STAR [CHAR] * EMIT ;
: TOP  STAR DROP ;

: SPACED-FILL  ( n -- )
STAR
1- 1 ?DO
SPACE
LOOP
STAR
;

: FULL-ROW  ( nspaces nstars -- )
SWAP SPACES
0 ?DO
STAR
LOOP
;

: EMPTY-ROW  ( nspaces nstars -- )
SWAP SPACES
DUP 1 = IF
TOP
ELSE
SPACED-FILL
THEN
;

: FULL-PYRAMID  ( nheight -- )
CR
1+
DUP 1 ?DO
I CALC-SPACES
I CALC-STARS
FULL-ROW CR
LOOP
DROP
;

: EMPTY-PYRAMID  ( nheight -- )
CR
1+
DUP 1 ?DO
I CALC-SPACES
I CALC-STARS
EMPTY-ROW CR
LOOP
DROP
;

: FULL-DIAMOND  ( (nheight / 2 + 1) -- )
DUP FULL-PYRAMID
1- DUP
0 ?DO
DUP I - 2* 1-
I 1+
SWAP
FULL-ROW CR
LOOP
DROP
;

: EMPTY-DIAMOND  ( (nheight / 2 + 1) -- )
DUP EMPTY-PYRAMID
1- DUP
0 ?DO
DUP I - 2* 1-
I 1+
SWAP
EMPTY-ROW CR
LOOP
DROP
;

-Mari

#### Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

#### Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Close Box

# Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

• Talk To Other Members
• Notification Of Responses To Questions
• Favorite Forums One Click Access
• Keyword Search Of All Posts, And More...

Register now while it's still free!