Forth

[Chr$]

Hmmm, looks a bit like my tartan:

dunbar_mod_big.jpg

which, I have to say, is bloody awful. So I have a kilt in this one, Pride of Scotland:

KTF-PSCO.jpg

Much easier on the eye!

Cheers,
Norm.

I suppose if there's one thing a QL is quite good for, it must be reproducing the red/green/black tartan colours in mode 4. One of my Great-grandfathers was a Kerr. The Kerr tartan is also very similar.

I think I've been to Scotland a total of 3 times in my life so the next time will be the forth

[NormanDunbar]

I see what you did ther Chr$.

Cheers,
Norm

PS. Fixing the mother in law Thursday, ..... hopefully!

[polka]

Hi all,

This is the complete version of my TARTAN generator, working on a BBQL both in 4 colors 512x256 and in 8 colors 256x256 MODES.

For Supper Forth !

On a modern 16/9 LDC TV, the BBQL displays square pixels in MODE 4, and gets the (good) aspect ratio using words 4WEAVE ; but to get the same (good) aspect ratio in MODE 8, the 8WEAVE word draws the same pixel line twice.

In MODE 4 you may use 2 to 4 color codes and in mode 8 you can use up to 8 color codes. So the WARPs and WEFTs that you will create with the TARTAN construct must be adapted to the display mode you intend to use !

Code: Select all

CR CR .( tartan48_fth )

( COLOR CONSTANTS )

0 CONSTANT BLACK
1 CONSTANT BLUE 
2 CONSTANT RED 
3 CONSTANT MAGENTA
4 CONSTANT GREEN 
5 CONSTANT CYAN 
6 CONSTANT YELLOW 
7 CONSTANT WHITE

HEX

( 4COLORS TABLE )

CREATE 4COLORS
7F7F , BFBF , DFDF , EFEF , F7F7 , FBFB , FDFD , FEFE , 
0080 , 0040 , 0020 , 0010 , 0008 , 0004 , 0002 , 0001 ,
8000 , 4000 , 2000 , 1000 , 0800 , 0400 , 0200 , 0100 ,
8080 , 4040 , 2020 , 1010 , 0808 , 0404 , 0202 , 0101 , 

( 8COLORS TABLE )

CREATE 8COLORS
3F3F , CFCF , F3F3 , FCFC , 0040 , 0010 , 0004 , 0001 ,
0080 , 0020 , 0008 , 0002 , 00C0 , 0030 , 000C , 0003 ,
8000 , 2000 , 0800 , 0200 , 8040 , 2010 , 0804 , 0201 ,
8080 , 2020 , 0808 , 0202 , 80C0 , 2030 , 080C , 0203 ,

DECIMAL

( DOT for MODE 4 )

: 4DOT ( c,x,y --- )
  128 * SWAP 8 /MOD 2* ROT + 0 131072. D+ 
  2DUP A@ 3 PICK 2* 4COLORS + @ AND 4 PICK 0>
  IF 4 ROLL 2/ 16 * 4 ROLL 2* + 4COLORS + @ OR 
  ELSE >R 2SWAP 2DROP R> 
  THEN ROT ROT A! ;

( DOT for MODE 8 )

: 8DOT ( c,x,y --- )
  128 * SWAP 4 /MOD 2* ROT + 0 131072. D+ 
  2DUP A@ 3 PICK 2* 8COLORS + @ AND 4 PICK 0>
  IF 4 ROLL 8 * 4 ROLL 2* + 8COLORS + @ OR 
  ELSE >R 2SWAP 2DROP R>
  THEN ROT ROT A! ;

VARIABLE COLOR

( TEST FOR 4DOT - syntax : black, red, green or white 4TDOT )

: 4TDOT ( color --- ) TIME ROT
  COLOR ! 256 0 DO 512 0 DO COLOR @ I J 4DOT LOOP LOOP
  TIME 2SWAP D- KEY 2DROP . ;

( TEST FOR 8DOT - syntax : any of the eight colors 8TDOT )

: 8TDOT ( color --- ) TIME ROT
  COLOR ! 256 0 DO 256 0 DO COLOR @ I J 8DOT LOOP LOOP
  TIME 2SWAP D- KEY 2DROP . ;


( ============================================================ )


( Creating a TARTAN with up to 4 or 8 colors, depending on MODE )

VARIABLE L

: WARP HERE 1 ALLOT 0 L ! ;

: WEFT 
  CREATE DUP C@ DUP C, HERE SWAP DUP * ALLOT 
  OVER C@ 0 2DUP 
  DO 2DUP 
     DO I J + 4 MOD 2/
        IF I ELSE J THEN
        4 PICK 1+ + C@
        4 + PICK
        4 PICK C@ I * J +
        4 PICK + C! 
     LOOP 
  LOOP 
  2DROP 2DROP ;

: TARTAN CREATE WARP DOES> WEFT ;

: | SWAP 0 DO DUP C, 1 L +! LOOP DROP ;

: END_TARTAN L @ SWAP C! ;

( WEAVEing it on full 512x256 4 colors screen )

: 4WEAVE 
  DUP C@ L ! 1+ 256 0 
  DO I L @ MOD L @ * 512 0
     DO 2DUP I L @ MOD + + C@ 
        I J 4DOT
     LOOP DROP
  LOOP KEY 2DROP ;

( WEAVEing it on full 256x128 8 colors screen )

: 8WEAVE 
  DUP C@ L ! 1+ 128 0 
  DO I L @ MOD L @ * 256 0 
     DO 2DUP I L @ MOD + + C@ 
        I J 2* >R 2DUP R@ 8DOT R> 1+ 8DOT 
     LOOP DROP
  LOOP KEY 2DROP ;
  
  END_FILE

You may notice that after defining the two basic pixel plotting words 4DOT and 8DOT, I wrote two test words 4TDOT and 8TDOT which will paint the whole display in one color, and I included two calls to the TIME words, to compute the speed of these test words. To use these words you may type :

<color> 4TDOT in MODE 4 or <color> 8TDOT in mode 8 ; when <color> is BLACK, the test words run indeed faster.

Some (other stupid) tests for testing the TARTAN words

1/ For MODE 4

Code: Select all

TARTAN 4TWARP
   8 0 | 8 1 | 8 2 | 8 3 | 
END_TARTAN

BLACK RED GREEN WHITE 4TWARP 4TWEFT

.( in MODE 4, type : "4TWEFT 4WEAVE" ) CR

END_FILE

2/ For MODE 8

Code: Select all

TARTAN 8TWARP
   8 0 | 8 1 | 8 2 | 8 3 | 8 4 | 8 5 | 8 6 | 8 7 |
END_TARTAN

BLACK BLUE RED MAGENTA GREEN CYAN YELLOW WHITE 8TWARP 8TWEFT

.( in MODE 8, type : "8TWEFT 8WEAVE" ) CR

END_FILE

Of course, 512x256 (in MODE 4) and 256x128 (in mode 8) are not very detailed resolutions, and if you want to save the display files (for instance as GIF files) in order to stitch several together, it is recommendable to design the WARPs with lengths powers of 2 ( 4, 8, 16, 32, 64 or 128 - not more than that ! )

I was looking for an example of a 8 WARP 2 colors (black and white), that in France we call pied-de-poule (litteral translation : hen's foot) but in english, it is called houndstooth or dogstooth.

As I googled for it I stumbled on an amusing publication :

Cellular Automata-Based Generative Design of Pied-de-poule Patterns using Emergent Behavior: Case Study of how Fashion Pieces can Help to Understand Modern Complexity
Loe Feijs 1,* and Marina Toeters 2

http://www.ijdesign.org/index.php/IJDes ... e/3050/825

and also found out that THIS version of my program was not suitable for generating it exactly...

[polka]

This program (that I finally named FOLLY - why not ?) was first written for ComputerOne FORTH and with french keywords.

I converted it here for SupperForth idiosyncrasies and with english keywords.

It's all about teaching young children how to code with the simplest programming langage - and for them, to get an interesting feed-back, that means GRAPHICS !

When you load this program ( LOAD_FILE mdv2_FOLLY_fth -> on a Sinclair QL running SupperForth in MODE 8 - eight colors), you will get a black work space with a red sort of grid, and a red dialog window for 2 lines of text.


If you look at the Source file :

Code: Select all

2VARIABLE SCREEN  0 OPEN CON_486x249a12x5    SCREEN 2!
2VARIABLE WORKSP  0 OPEN CON_482x205a14x6    WORKSP 2!
2VARIABLE DIALOG  0 OPEN CON_482x40a14x213   DIALOG 2!

: WINDOW 2@ 2DUP #IN 2! #OUT 2! ;

: BGD #DEFAULT 2DUP #IN 2! #OUT 2! 0 PAPER CLS
      SCREEN WINDOW 7 PAPER CLS
      WORKSP WINDOW 0 PAPER CLS
      DIALOG WINDOW 2 PAPER 2 STRIP 7 INK 2 1 CSIZE CLS ;

: BG 26886 2310 DO 116 0 DO 2 I J + 2 A! 4 +LOOP 1536 +LOOP ;
: SG 26118 1540 DO 118 0 DO 2 I J + 2 A! 2 +LOOP 768 +LOOP ;

EXVEC: GRID

HEX
  
VARIABLE COLOR

   : black      0 COLOR ! ;
   : blue      55 COLOR ! ;
   : red       AA COLOR ! ;
   : magenta   FF COLOR ! ;
   : green   AA00 COLOR ! ;
   : cyan    AA55 COLOR ! ;
   : yellow  AAAA COLOR ! ;
   : white   AAFF COLOR ! ;

AAFF.A8FC 2CONSTANT FC

CREATE TURN

 AAFF , A8FC , AAFF , A8FC , AAFF , A8FC , AAFF , A8FC , AAFF ,
 A0F0 , AAFF , A0F0 , AAFF , A0F0 , AAFF , 80C0 , AAFF , 80C0 ,
 AAFF , 0000 , A0F0 , 0000 , A8FC , A8FC , A0F0 , A0F0 , 80C0 ,
 A0F0 , 0000 , AAFF , 0000 , AAFF , 80C0 , AAFF , 80C0 , AAFF ,
 A0F0 , AAFF , A0F0 , AAFF , A0F0 , AAFF , A8FC , AAFF , A8FC ,
 AAFF , A8FC , AAFF , A8FC , 80C0 , A0F0 , A0F0 , A8FC , A8FC ,
 0000 , 283C , 0203 , A8FC , 0A0F , A8FC , 0A0F , A8FC , 2A3F ,
 A8FC , 2A3F , A8FC , 2A3F , A8FC , AAFF , A8FC , AAFF , A8FC ,
 AAFF , A8FC , AAFF , A8FC , 080C , 283C , 283C , A8FC , A8FC ,
 AAFF , A8FC , AAFF , A8FC , AAFF , A8FC , AAFF , A8FC , 2A3F ,
 A8FC , 2A3F , A8FC , 3A3F , A8FC , 0A0F , A8FC , 0A0F , A8FC ,
 0203 , A8FC , 0000 , 283C , A8FC , A8FC , 283C , 283C , 080C ,

DECIMAL

VARIABLE AZIMUTH
2VARIABLE XY

60 CONSTANT SMX
34 CONSTANT SMY

30 CONSTANT BMX
17 CONSTANT BMY

EXVEC: MX
EXVEC: MY

( color,x,y -- )

: SMALL-STEP
   5 0 DO 
      2DUP 6 * I + 128 * SWAP 2* + 
      3 PICK FC DROP AND SWAP 900 + 2 A!
   LOOP 
   2DROP DROP 
;

: BIG-STEP
   11 0 DO
      2DUP 12 * I + 128 * SWAP 2* 2* + DUP 
      4 PICK FC SWAP >R AND SWAP 900 + 2 A!
      3 PICK R> AND SWAP 902 + 2 A!
   LOOP 
   2DROP DROP 
;

0 CONSTANT SOUTH
1 CONSTANT EAST
2 CONSTANT NORTH
3 CONSTANT WEST

EXVEC: PLOT-STEP

: step
   COLOR @ XY 2@ PLOT-STEP XY 2@ AZIMUTH @
   CASE SOUTH OF 1+ MY MOD           XY 2! ENDOF
        EAST  OF SWAP 1+ MX MOD SWAP XY 2! ENDOF
        NORTH OF 1- MY MOD           XY 2! ENDOF
        WEST  OF SWAP 1- MX MOD SWAP XY 2! ENDOF
   ENDCASE
;

: steps
   0 DO step LOOP
;

( color,v,x,y -- )

: SMALL-TURN
   5 0 DO 
      2DUP 6 * I + 128 * SWAP 2* + 
      3 PICK 2/ 27 * I + 22 + 2* TURN + @ 
      5 PICK AND SWAP 900 + 2 A!
   LOOP 
   2DROP 2DROP 
;

: BIG-TURN
   11 0 DO 
      2DUP 12 * I + 128 * SWAP 2* 2* + I 2* 2*
      4 PICK 27 * + TURN + 2@ 
      6 PICK AND 2 PICK 900 + 2 A!
      5 PICK AND SWAP 902 + 2 A!
   LOOP 2DROP 2DROP 
;

EXVEC: PLOT-TURN

: SOUTH>EAST
   COLOR @ 6 XY 2@ PLOT-TURN
   XY 2@ SWAP 1+ MX MOD SWAP XY 2!
   EAST AZIMUTH !
;

: EAST>NORTH
   COLOR @ 0 XY 2@ PLOT-TURN
   XY 2@ 1- MY MOD XY 2!
   NORTH AZIMUTH !
;

: NORTH>WEST
   COLOR @ 2 XY 2@ PLOT-TURN
   XY 2@ SWAP 1- MX MOD SWAP XY 2!
   WEST AZIMUTH !
;

: WEST>SOUTH
   COLOR @ 4 XY 2@ PLOT-TURN
   XY 2@ 1+ MY MOD XY 2!
   SOUTH AZIMUTH !
;

: left
   AZIMUTH @
   CASE SOUTH OF SOUTH>EAST ENDOF
        EAST  OF EAST>NORTH ENDOF
        NORTH OF NORTH>WEST ENDOF
        WEST  OF WEST>SOUTH ENDOF
   ENDCASE
;

: SOUTH>WEST
   COLOR @ 0 XY 2@ PLOT-TURN
   XY 2@ SWAP 1- MX MOD SWAP XY 2!
   WEST AZIMUTH !
;

: EAST>SOUTH
   COLOR @ 2 XY 2@ PLOT-TURN
   XY 2@ 1+ MY MOD XY 2!
   SOUTH AZIMUTH !
;

: NORTH>EAST
   COLOR @ 4 XY 2@ PLOT-TURN
   XY 2@ SWAP 1+ MX MOD SWAP XY 2!
   EAST AZIMUTH !
;

: WEST>NORTH
   COLOR @ 6 XY 2@ PLOT-TURN
   XY 2@ 1- MY MOD XY 2!
   NORTH AZIMUTH !
;

: right
   AZIMUTH @
   CASE SOUTH OF SOUTH>WEST ENDOF
        EAST  OF EAST>SOUTH ENDOF
        NORTH OF NORTH>EAST ENDOF
        WEST  OF WEST>NORTH ENDOF
   ENDCASE
;

: small
   ASSIGN GRID TO-DO SG
   ASSIGN MX TO-DO SMX
   ASSIGN MY TO-DO SMY
   ASSIGN PLOT-STEP TO-DO SMALL-STEP
   ASSIGN PLOT-TURN TO-DO SMALL-TURN
;

: big
   ASSIGN GRID TO-DO BG
   ASSIGN MX TO-DO BMX
   ASSIGN MY TO-DO BMY
   ASSIGN PLOT-STEP TO-DO BIG-STEP
   ASSIGN PLOT-TURN TO-DO BIG-TURN
;

: LEFT-BOTTOM
   1 MY 2 - XY 2! NORTH AZIMUTH ! red step
;

EXVEC: start
ASSIGN start TO-DO LEFT-BOTTOM

: zap
   BGD GRID start ;

big zap

END_FILE

you see that most words that constitute the program are (UPPERCASE) FORTH words.The words that are lowercase are the interface keywords of my simple programming langage :

First, you have 8 colors :

black
blue
red
magenta
green
cyan
yellow
white

Then you have three graphic primitives :

step
left
right

and actually a fourth one :

steps

In the lower dialog window you may use all these words to get graphic plotting in the upper work space. All keywords but "steps" need no parameter ; "steps" requires how many ? -> one number !

Now first, if you need to clear and initialise the work space say :

zap

Actually, you have also two graphic configure options :

small
big


Try : "small" with "zap" and "big" with "zap" and then play with the lowercase keywords :

1.jpg (68.57 KiB) Viewed 1883 times

So, you just used these words as interactive commands. try :

8 steps right

and repeat it four times !

But what about coding ? try :

: side 8 steps right ;

then try :

zap green side

2.jpg (65.14 KiB) Viewed 1883 times

blue side side side

3.jpg (70.42 KiB) Viewed 1883 times

How about trying ?

: square side side side side ;

and then :

zap cyan square

4.jpg (68.57 KiB) Viewed 1883 times

4>

This is coding ! And you can code a lot of things, for instance :

: 2_sides 5 steps right 8 steps right ;
: rectangle 2_sides 2_sides ;

Or :

: stair 2 steps right 3 steps left ;
: staircase stair stair stair stair stair ;

My ComputerOne french version of FOLLY had one more construct that I did not for the moment succeed to add to the SupperForth version (another post about this issue... when I solve it).

because I defined a new control structure analog to "DO ... LOOP" but simpler :

... n times( something ) ...

This does not work for the moment with SupperForth !

But when it works you might recode square or staircase another way :

: square 4 times( side ) ;
: staircase 5 times( stair ) ;

And even better, you may define a word "stairs" :

: stairs times( stair ) ;

to be used as a command requiring to tell (how many ?) like "steps" :

3 stairs
5 stairs
8 stairs

"steps" itself could have been defined this way :

: steps times( step ) ;

To conclude (this post) : where did I mention STACKs ?

When teaching FORTH the first thing NOT TO DO is to introduce stacks and RPN !