Camel99 Forth Information goes here

[GDMike]

33 minutes ago, Lee Stewart said:

I have the R. G. Loeliger book, Threaded Interpretive Languages, that came as a result (I think) of that Byte issue (I might even have that issue buried somewhere here!). It was published by Byte Publications with the graphic on its cover from the cover of that issue. I just saw a used copy on Amazon for $149!! You can read it here—or I could sell you mine (just kidding).

 

...lee

This Byte article has some, actually quite a bit to my surprise, of reading material and related.

I scanned over it just to get a glimpse, they even discussed the "Field Name lists", and it's makeup and a whole bunch of other good stuff.

And some stuff I didn't even know about.. oh, and that breakout game written by, I think a high schooler at the time. ?

I'll eventually find a copy of that byte magazine, I can't believe it's not listed on eBay, as I've found a few of the 1980's volumes, just not that one. 

It'll show up. I've already got 1985&1987 volumes. Yay ?

[+TheBF]

2 hours ago, GDMike said:

This Byte article has some, actually quite a bit to my surprise, of reading material and related.

I scanned over it just to get a glimpse, they even discussed the "Field Name lists", and it's makeup and a whole bunch of other good stuff.

And some stuff I didn't even know about.. oh, and that breakout game written by, I think a high schooler at the time. ?

I'll eventually find a copy of that byte magazine, I can't believe it's not listed on eBay, as I've found a few of the 1980's volumes, just not that one. 

It'll show up. I've already got 1985&1987 volumes. Yay ?

"they even discussed the "Field Name lists", and it's makeup and a whole bunch of other good stuff."

 

Also remember that there is not a standard way to make a Forth system so whatever they are talk about regarding internal details is interesting but may not  be the same as your favourite system.

 

The saying goes: "If you've seen one Forth, you've seen one Forth" 

[GDMike]

13 hours ago, GDMike said:

I'll have to read--> the R. G. Loeliger book, Threaded Interpretive Languages

Thanks Lee.

Edited June 22, 2021 by GDMike

[+Lee Stewart]

21 hours ago, Lee Stewart said:

I am not sure why you think you need TOUPPER code in the mix. That would screw up a radix higher than 36. Though not likely to be used all that often, I suppose, but I can actually think of reasons to use a radix like 60.

 

20 hours ago, Lee Stewart said:

Oops! Using a radix higher than 36 would need a different DIGIT? definition because [ \ ] ^ are all resident definitions and would never get through INTERPRET as numbers. Oh, well!

 

On closer look, radices higher than 36 will work just fine. The number just needs to have a leading 0 if it contains digits that cause the number to look like a defined word. For example, in radix 60, 0[ (36₁₀), 0\ (37₁₀), 0] (38₁₀), 0^ (39₁₀) would all be successfully pushed to the stack as numbers even though, without the leading 0, they are fbForth words. However, without writing new words for handling such a radix, it would be rather impractical to work with such numbers because the highest, 16-bit number expressible would be 0ICF₆₀ (65535₁₀). Now, back to your regularly scheduled program ...

 

...lee

[+TheBF]

I played with GForth and the reason it has toupper is because it is a case-insensitive system and they want numbers to be interpreted case insensitive as well.

 

HEX  DEAD dead =  \ true 

My interpreter loop is vectored so I should be able to make a case insensitive system option pretty easily... hmmmm

[+TheBF]

"That was Easy" as the advertisement used to say.

 

The INTERPET word in Camel Forth takes a stack string pair as an argument. ( addr len )

Making a TOUPPER word is not tricky so put them together and you get a case insensitive interpreter.

NUMBER?  is baked into and NUMBER? is not vectored so that would be trickier to change although it could be patched.

 

TOUPPER should be CODE or a least the code inside the loop should be CODE but as an small add-on this is not bad.

 

\ NOCASE.FTH   allows case insensitve code for Camel99   Fox  June 2021

: LOWER? ( c -- c')  [CHAR] a [ CHAR z 1+ ] LITERAL WITHIN ;

HEX
: TOUPPER ( addr len -- addr len) \ change string  in place
          2DUP BOUNDS
          ?DO
             I C@ DUP LOWER?
             IF 05F AND THEN I C!
          LOOP ;

: <LOINTERP>  ( addr len -- ) TOUPPER  <INTERP> ; \ New interpreter word

: UCASE     ['] <INTERP>    'IV ! ;  \ go back to default case senstive sys.
: NOCASE    ['] <LOINTERP>  'IV ! ;  \ change interpreter vector for low case

 

[+TheBF]

No doubt Lee has already seen the folly of my ways and chosen to let me discover it on my own. ?

 

With my quick and dirty approach above this code:

: HELLO  CR ." Hello World" ;  

 

Outputs:

HELLO WORLD! 

All the input to the interpreter is passing through TOUPPER.

 

What is needed is TOUPPER must be applied only to the word strings that are passed to FIND.

I have a vector for FIND as well so I will try that next.

[+Lee Stewart]

4 hours ago, TheBF said:

No doubt Lee has already seen the folly of my ways and chosen to let me discover it on my own. ?

 

Though I may have seen it had I pored over it, you probably give me more credit than I deserve. At any rate, I got sidetracked with life yesterday afternoon/evening so no opportunity for said poring-over. I need to look more closely at vectors, anyway. Nice work. ?

 

...lee

[+TheBF]

2 hours ago, Lee Stewart said:

 

Though I may have seen it had I pored over it, you probably give me more credit than I deserve. At any rate, I got sidetracked with life yesterday afternoon/evening so no opportunity for said poring-over. I need to look more closely at vectors, anyway. Nice work. ?

 

...lee

I hope life is treating you ok. 

 

I use the term "vectors" but in fact they are just variables that hold a CFA.

VARIABLE 'IV

In the kernel I don't have room to mess around with anything fancy and I never did make a CREATE/DOES> in the cross-compiler to do any fancy stuff.

It has been hard enough for me to make a bug-free kernel with the simple stuff as is displayed here routinely. ?

 

To make "vectors" work I use colon definitions with PERFORM.

PERFORM is just  "@ EXECUTE "  in a CODE word. It's an attempt to minimize the speed hit on these important words.

: INTERPRET   'IV PERFORM ;
: FIND        'FIND PERFORM ; 

 

Bonus detail for Forth students

This actually began because of the problem of making Forth in Forth where there are no forward references.

You don't have this problem when you build Forth with an Assembler like sensible people do.

 

I kept re-arranging the order of the words in the file but there was one sequence of words where I had to have a forward reference.

 

INTERPRET   calls  ABORT

ABORT         calls  QUIT

QUIT           calls  INTERPRET   

 

So I added the 'IV variable and defined INTERPRET as above, defined QUIT so I could define ABORT and patch the address of <INTERP> into 'IV when the whole shebang starts up. 

Find came later so I could add wordlist/vocabulary support to the kernel as a library file.

 

[+TheBF]

Yes but is it a "Compiler" 

 

An interesting ongoing discussion on the board about TI BASIC being "double interpreted" led to discussion about Forth and its use of the word compile. ie: Is traditional Forth a "compiler".

I thought I would take it back here where it fits better and stop being a pesky Forth zealot in the other thread.

 

It is safe to say that Forth is not a traditional compiler from the Fortran lineage where we translate source to object code, link object code to an executable program, load the executable and run it.

However neither is it a recursive descent compiler in the line of Turbo Pascal where you can do a single pass on the source code and generate executable code.

 

Chuck Moore cut his own path. He has no Comp Sci degree. He is a physics grad who simply wanted to get work done faster. He turned the problem of the human/computer interface upside down and stripped away anything that got in his way. Chuck created his own understanding of the word compiler which strips the concept down to a minimal form of the beast. 

 

A definition of "compiler" from Wikipedia:

In computing, a compiler is a computer program that translates computer code written in one programming language

(the source language) into another language (the target language).
The name "compiler" is primarily used for programs that translate source code from a high-level programming language to a lower level language
(e.g., assembly language, object code, or machine code) to create an executable program.

 

By this definition one could say that threaded Forth has a compiler because it takes "the source language" and translates it into another lower level language.

In a threaded system that language is for a virtual machine.

The virtual machine runs an instruction set that looks like a list of addresses but it is an instruction set nevertheless.  In fact to handle all the variations of Forth that exist the ANS committee had to use the term "execution token" (XT) to refer to these things because they are not always pointers to code. They can be bytes, sub-routines, pointers to pointers to code or even the native instruction of Forth CPUs.

Many conventional compilers "compile" to an intermediate language to make code generation simpler so threaded Forth is not far from that concept.

 

What's more even a rank amateur programmer like me can expand the code connected to those addresses and compile it inline converting VM code to native code compiling from the same source code.

 

On the surface you would be tempted to call threaded Forth an Assembler for the virtual machine because many of the instructions are a one-to-one relationship. ( + -  * / DUP SWAP etc)

However all of the branching and looping words are written in Forth and they do compiling stuff to compile the appropriate VM instructions inline and compute the addresses in the branches and loops.

And CREATE /DOES> is a simple form of object oriented programming where we can add new compiler directives to the language that can compile VM code or native code.

 

So I think we can say threaded Forth has a compiler.  I will grant that it is unconventional. 

 

By the way here is that minimal compiler in Chuck Moore's opinion:

  ,

That's right. The single comma in Forth qualifies as a compiler in Chuck Moore's world. It is not a delimiter. 

It takes a number from the data stack, "compiles" it into memory and advances the memory pointer.

With that simple tool you can create anything. :) 

 

 

 

[+TheBF]

Camel99 Forth V2.67d

 

The zip file has only the Forth kernel file. Replace the version that you have with this one.

It is has a fix on the word DIGIT? and it works properly now.

The bug symptom was that the interpreter would not abort with an error with some inputs that are not Forth words and are also NOT numbers.

Examples:  ---   <<<   

 

My apologies I did not notice it for quite a while after re-writing DIGIT? as a code word. 

 

Todo:  Make these changes on the SuperCart version.

 

 

CAMEL267D.zip

[+TheBF]

How does Forth get a number onto the data stack?

 

If you are interpreting the system puts numbers on the data stack by default.

If you are compiling the system compiles numbers with a little code routine called LIT  that puts the number on the data stack when it is executed at runtime.

 

More details?   OK

 

Below  is the Camel99 Interpreter and compiler hi-level loop in cross-compiler Forth.   

c-addr u is the address and length of the input string to the routine.

 

Compiler on/off is controlled by the STATE variable.

 

Ignoring some noise details and Forth syntax, 

We parse each word in the string  with WORD 

 

We test the STATE variable (and another bit but ignore that)

If the state =0 we execute the word (immediate mode)

else we compile it.

 

If we couldn't find it try converting the string to a number

If NUMBER? fails we have an error 

 

if conversion worked then LITERAL makes the interpret/compile decision internally

- Interpret mode: put number of data stack 

- compile mode: compile the code to put the number of the data stack at runtime.

 

More than you wanted to know I bet.

 

: <INTERP>  ( c-addr u -- )
          'SOURCE 2!  >IN OFF
          BEGIN
              BL WORD DUP C@ ( -- addr len)
          WHILE
              FIND ?DUP
              IF ( it's a word)
                   1+ STATE @ 0= OR
                   IF   EXECUTE
                   ELSE COMPILE,
                   THEN
              ELSE ( it's a number)
                   COUNT NUMBER? ?ERR
                   t[COMPILE] LITERAL
              THEN
              DEPTH 0< TS" Short stack" ?ABORT
          REPEAT
          DROP ;

 

 

 

[+TheBF]

Major Github cleanup for V2.67

 

I remove a lot of the cruft that was there and the directory structure is now correct for you to download the source and build the system from scratch.

(Have to not test it myself yet)   But that's the theory.

 

GitHub - bfox9900/CAMEL99-V2: Latest work on CAMEL99 Forth that includes changes that are not compatible with the first version

 

There are also updated pdf files of the three documents that explain the TI-99 system pretty well.

I still have a cross-compiler document outstanding.

 

CAMEL99-V2/DOCS at master · bfox9900/CAMEL99-V2 · GitHub

 

[+TheBF]

Well this took a bit longer than I expected but it works now.

I was wondering if I could convince Forth to swallow character pattern DATA statements from Magellan in BASIC format.

 

So by creating some words to parse the input buffer and convert things to a number or a string we can do it!

I even take in the line numbers.    ( I just drop them, but it is once less thing to change in the text)

Spoiler

\ BASIC DATA STATEMENT READER JUNE 2021  Brian Fox
\ More compatible with TI ASM DATA statements Jan 2018
NEEDS .S   FROM DSK1.TOOLS
NEEDS CALLCHAR FROM DSK1.GRAFIX

: QUOTE?  ( addr len -- addr len ? ) OVER C@ [CHAR] " = ;

\ cut leading quote char and last quote char
: /QUOTES ( addr len -- addr' len')  1 /STRING   1-  ;

: GET-TOKEN ( -- addr len) [CHAR] , PARSE-WORD ; \ comma delimited

: EXPECT# ( addr len -- n)
      BL SKIP                           \ skip leading spaces
      NUMBER? ABORT" Number expected" ; \ convert string to no,

: EXPECT$ ( addr len -- addr len)
      QUOTE? 0= ABORT" String expected" \ test for leading quote
      /QUOTES ;

: DATA ( <TEXT>,<TEXT> ... )
        DROP    \ don't need the line number
         BEGIN
             GET-TOKEN DUP
         WHILE
            EXPECT# GET-TOKEN EXPECT$
            ROT CALLCHAR
         REPEAT
         2DROP ;

DECIMAL

\ REM CHARACTER DATA
500 DATA 33,"0010101010001000",34,"0024240000000000",35,"00247E24247E2400",36,"00083E283E0A3E08"
510 DATA 37,"0062640810264600",38,"001028102A443A00",39,"0008100000000000",40,"0004080808080400"
520 DATA 41,"0020101010102000",42,"000014083E081400",43,"000008083E080800",44,"0000000000080810"
530 DATA 45,"000000003E000000",46,"0000000000181800",47,"0000020408102000",48,"003C464A52623C00"
540 DATA 49,"0018280808083E00",50,"003C42023C407E00",51,"003C420C02423C00",52,"00081828487E0800"
550 DATA 53,"007E407C02423C00",54,"003C407C42423C00",55,"007E020408101000",56,"003C423C42423C00"
560 DATA 57,"003C42423E023C00",58,"0000001000001000",59,"0000100000101020",60,"0000040810080400"
570 DATA 61,"0000003E003E0000",62,"0000100804081000",63,"003C420408000800",64,"003C4A565E403C00"
580 DATA 65,"003C42427E424200",66,"007C427C42427C00",67,"003C424040423C00",68,"0078444242447800"
590 DATA 69,"007E407C40407E00",70,"007E407C40404000",71,"003C42404E423C00",72,"0042427E42424200"
600 DATA 73,"003E080808083E00",74,"0002020242423C00",75,"0044487048444200",76,"0040404040407E00"
610 DATA 77,"0042665A42424200",78,"004262524A464200",79,"003C424242423C00",80,"007C42427C404000"
620 DATA 81,"003C4242524A3C00",82,"007C42427C444200",83,"003C403C02423C00",84,"00FE101010101000"
630 DATA 85,"0042424242423E00",86,"0042424242241800",87,"00424242425A2400",88,"0042241818244200"
640 DATA 89,"0082442810101000",90,"007E040810207E00",91,"000E080808080E00",92,"0000402010080400"
650 DATA 93,"0070101010107000",94,"0010385410101000",96,"001C227820207E00",97,"000038043C443E00"
660 DATA 98,"0020203C22223C00",99,"00001C2020201C00",100,"0004043C44443E00",101,"0000384478403C00"
670 DATA 102,"000C101810101000",103,"00003C44443C0438",104,"0040407844444400",105,"0010003010103800"
680 DATA 106,"0004000404042418",107,"0020283030282400",108,"0010101010100C00",109,"0000685454545400"
690 DATA 110,"0000784444444400",111,"0000384444443800",112,"0000784444784040",113,"00003C44443C0406"
700 DATA 114,"00001C2020202000",115,"0000384038047800",116,"0010381010100C00",117,"0000444444443C00"
710 DATA 118,"0000444428281000",119,"0000445454542800",120,"0000442810284400",121,"00004444443C0438"
720 DATA 122,"00007C0810207C00",123,"000E083030080E00",124,"0008080808080800",125,"0070100C0C107000"
730 DATA 126,"00324C0000000000"

 

 

[+TheBF]

GPL had some Forth influence?

 

I am toying with the idea of making an RPN GPL Assembler just to see what happens.

I was looking around the site and found some ROM code in a discussion about how to make GPL run from VDP RAM.

 

With a data stack, a return stack and this little snippet I smell something Forthy.

NEXT   LIMI 2                 ALLOW INT'S BETWEEN GPL INSTN'S
HX0002 EQU  $-2
C074   LIMI 0
       MOVB *R13,R9           LOAD INSTN FROM GAME ROM.
       JLT  ABOPS             JMP IF MS BIT SET
       MOVB R9,R4             MOVE INSTN TO WORK REG'R
       SRL  R4,12             LEAVE TOP 3 BITS *2
       MOV  @ITAB(R4),R5      GET BRANCH ADDRESS
       B    *R5               B @MICSLN, MOVDAT, BRESET, BSET
 

NEXT  looks like a pregnant version of NEXT in the Forth systems around here with a byte code instruction added to it and interrupt polling.

 

[GDMike]

Btw, are you using an F18A? I'm looking for some help on how to manipulate character color/screen color Palette data in assembly, but even if I saw it in Forth, I might get a feeling for it..

I believe there are 58 registers, the card is a 100mhz virtual 9900, FPGA I believe, so it understands 9900 code, and 2mb of it's own system ram, don't think we can tap that, and I see how to detect the card now, from Matt's code from 2013. But that's all I'm able to figure so far..

Edited July 1, 2021 by GDMike

[Asmusr]

3 minutes ago, GDMike said:

and 2mb of it's own system ram

Unfortunately only 2KiB ?

This documentation is mostly still valid.

F18A documentation.pdf

f18a_register_use.ods

[GDMike]

Oooops...2kib... not 2MB..yikes

[GDMike]

15 hours ago, Asmusr said:

This documentation is mostly still valid.

I think it's the same thing that's already in the posts from 2013. 

But I had printed this out a couple weeks ago.

Edited July 2, 2021 by GDMike

[+TheBF]

4 hours ago, GDMike said:

Btw, are you using an F18A? I'm looking for some help on how to manipulate character color/screen color Palette data in assembly, but even if I saw it in Forth, I might get a feeling for it..

I believe there are 58 registers, the card is a 100mhz virtual 9900, FPGA I believe, so it understands 9900 code, and 2mb of it's own system ram, don't think we can tap that, and I see how to detect the card now, from Matt's code from 2013. But that's all I'm able to figure so far..

I have only made a configuration library and tested it on Classic99. Not full featured at all.

It shows you the register values to use. for config settings.  I cheated and looked at Mark's TF code and went from there.

[+TheBF]

5 hours ago, Asmusr said:

Unfortunately only 2KiB ?

This documentation is mostly still valid.

F18A documentation.pdf 782.02 kB · 4 downloads

f18a_register_use.ods 26.07 kB · 4 downloads

Well that's pretty fancy. I never took a minute to look at these docs before.

 

There seems to be some code examples.

I think where Forth would be handy as always with new hardware,  is you read and write the various registers interactively from the console to see what happens. You can do that right now to explore, then write Assembler code after.

Be careful not to BRICK the FPGA by writing to the flash memory however...

If you have specific questions about the doc contents I can try and help, but there are expert people on F18 here. I am starting from scratch and will just read the doc and try and grok it.

[GDMike]

Haha, yes. 2kiB, I'll load up a forth and see what I can break...lol

[Asmusr]

I think it would be very difficult to accidentally brick the F18A, even if you asked the GPU to execute random instructions. But GDMike doesn't need to use the GPU at all in order to use multi color characters or change the palette. That's all done by setting VDP registers and changing ordinary VDP RAM. If you need help to do anything specific I will try to help, but this should move to:

.

[+TheBF]

I have the attention span of a Gnat

 

And I found these cool demos on Youtube for different sorts that made sound as they ran.

I had to try it!   As always it was more trouble than I expected but its fun to watch.

 

Here are the results with three sorts. Bubble (slooow) Comb and insertion.

I am now tempted to try and put more than one on the screen at once and multi-task them. :-))))

 

Spoiler

\ sorting demo with sound effects

NEEDS .S     FROM DSK1.TOOLS
NEEDS HZ     FROM DSK1.SOUND
NEEDS .S     FROM DSK1.TOOLS
NEEDS VCHAR  FROM DSK1.GRAFIX
NEEDS RND    FROM DSK1.RANDOM
NEEDS VALUE  FROM DSK1.VALUES
NEEDS ELAPSE FROM DSK1.ELAPSE

MARKER /BARS
\ VCHAR bug fix to handle cnt=0
: (VCHAR)  ( col row char cnt -- )
          0 ?DO               ( -- char vadr)
             2DUP VC!       \ write a character
             C/L@ +         \ bump address by char-per-line
             DUP [ C/SCR @ 1- ] LITERAL >  \ subtract chars-per-screen-1
             IF
                 [ C/SCR @ 1- ] LITERAL -
             THEN
          LOOP ;

: VCHAR  ( col row char cnt -- )
           2SWAP            ( -- char cnt col row )
          >VPOS             ( -- char cnt vdp_addr)
          SWAP
          (VCHAR)
          2DROP
;

DECIMAL
32 CONSTANT SIZE  \ size of the data array

CREATE REFDATA
      11 , 13 , 10 , 29 , 09 , 23 , 14 , 12 ,
      16 , 30 , 26 , 17 , 28 , 15 , 25 , 32 ,
      01 , 31 , 18 , 02 , 03 , 08 , 05 , 07 ,
      27 , 19 , 21 , 06 , 20 , 24 , 22 , 04 ,

CREATE []Q   SIZE  CELLS 2+ ALLOT

: ]Q  ( n -- adr) CELLS []Q + ;   \ this is faster than using DOES>

: ERASE   0 FILL ;

\ load the array with different kinds of mixed up data
: CLRDATA   ( -- ) []Q SIZE CELLS ERASE ;     \ all the same data

: RANDDATA  ( -- ) REFDATA []Q  SIZE CELLS CMOVE ;

: TURTLES   ( -- )
           SIZE 1-  0 DO  1 I ]Q ! LOOP  \ init all to 1
           SIZE 0
            DO
               I    1 MAX  I 1+ ]Q !   \ each 2 elements are reversed
               I 1+ 1 MAX  I ]Q !
            2 +LOOP ;

: .DATA   SIZE 0 DO I ]Q @ . LOOP ;

\ Musical BAR graph
DECIMAL
 23 CONSTANT MAXH  \ max height of bars
     129 CONSTANT SQR
SQR  8 + CONSTANT SQR2
SQR2 8 + CONSTANT SQR3

S" FEFEFEFEFEFEFEFE" SQR CALLCHAR
S" FEFEFEFEFEFEFEFE" SQR2 CALLCHAR
S" FEFEFEFEFEFEFEFE" SQR3 CALLCHAR

SQR  SET#   16 2 COLOR  \ black shadow on left side
SQR2 SET#   13 2 COLOR  \ green
SQR3 SET#    7 2 COLOR  \ red

: NOTE  ( n -- ) 20 * 200 + HZ ;
: /BAR  ( n -- ) 0 BL MAXH VCHAR ;  \ erase bar

: .GRNBAR ( col -- )
        DUP ]Q @ DUP>R MAXH SWAP -  ( col height startrow )
        SQR2 R> VCHAR ;

: .REDBAR ( col -- )
        DUP ]Q @ DUP>R MAXH SWAP -  ( col height startrow )
        SQR3 R> VCHAR ;

: .BAR  ( col value -- )
        OVER /BAR
        DUP>R MAXH SWAP -  ( col height startrow )
        SQR R@ VCHAR
        R> NOTE ;

: ]Q.DRAW ( ndx -- ) DUP ]Q @ .BAR ; \ draw bar

: SOUND-ON      GEN1  15000 HZ  -6 DB ;

: SHOWDATA
       SOUND-ON
       32 0
       DO
          I ]Q.DRAW
       LOOP
       MUTE
;

\ scripting tools
: CLEARLN ( col row --)  BL 32 HCHAR ;
: TITLE:  0 23 2DUP CLEARLN  AT-XY    ;
: TIME:   0 1 AT-XY ;
: WAIT-KEY  BEGIN KEY? UNTIL ;

\ COMBSORT
VARIABLE GAP
VARIABLE ITEMS
VARIABLE ADR
VARIABLE SORTED

\ 100/135 is the fastest GAP ratio I have found. (versus 10/13)
: /1.3 ( N -- N ) 100 135 */  1 MAX ;
: XCHG  ( ADR ADR -- ) OVER @  OVER @ SWAP ROT !  SWAP ! ;
: +GAP  ( n -- )       GAP @ + ;

: COMBSORT ( n -- )
    SOUND-ON
    DUP GAP !
    BEGIN
        SORTED ON
        GAP @  /1.3  GAP !
        DUP GAP @ -  0
        DO
           I +GAP .REDBAR  I .GRNBAR
           I +GAP ]Q   I ]Q
           OVER @ OVER @ <
           IF
              XCHG
              SORTED OFF
           ELSE
              2DROP
           THEN
           I  +GAP ]Q.DRAW  I  ]Q.DRAW
        LOOP
        SORTED @  GAP @ 1 = AND
    UNTIL
    DROP
    MUTE
;

: BUBBLESORT  ( n -- )
    SOUND-ON
    BEGIN
        SORTED ON
        DUP 1-  0
        DO
           I 1+ .REDBAR  I .GRNBAR
           I 1+ ]Q   I ]Q
           OVER @ OVER @ <
           IF
              XCHG
              SORTED OFF
          ELSE
              2DROP
          THEN
          I 1+ ]Q.DRAW  I ]Q.DRAW
        LOOP
       SORTED @
   UNTIL
   DROP
   MUTE
;

0 VALUE V

: INSERT ( n -- )
     BEGIN
        DUP 1+  WHILE ( n>=0)
        DUP ]Q @  V > WHILE ( [n]Q > V)
        DUP 1+ .REDBAR  DUP .GRNBAR
        DUP 1+ ]Q  OVER ]Q XCHG
        DUP 1+ ]Q.DRAW  DUP ]Q.DRAW
        1-  ( n=n-1)
     REPEAT THEN
;

: INSERTIONSORT ( n --  )
   SOUND-ON
   1
   DO
     I ]Q @ TO V
     I 1- INSERT
     V  OVER 1+ ]Q !
     DROP
   LOOP
   MUTE  ;

\ DEMO scripts
: COMB
     RANDDATA
     PAGE SHOWDATA
     TITLE: ." Comb Sort"
     TICKER OFF
     SIZE COMBSORT SHOWDATA
     TIME: .ELAPSED
;

: BUBBLE
     RANDDATA
     PAGE SHOWDATA
     TITLE: ." Bubble Sort"
     TICKER OFF
     SIZE BUBBLESORT SHOWDATA
     TIME: .ELAPSED
;

: INSERTION
     RANDDATA
     PAGE SHOWDATA
     TITLE: ." Insertion Sort"
     TICKER OFF
     SIZE INSERTIONSORT SHOWDATA
     TIME: .ELAPSED
;

: RUN
      PAGE
      11 SCREEN
      BUBBLE  1500 MS
      COMB    1500 MS
      INSERTION
      WAIT-KEY ;

 

 

[GDMike]

I don't know what Post#998 is showing.

In Turboforth, there is a word "VWTR"

That writes the value in VALUE to VDP register REGISTER.

Example, $36 7 VWTR 

Changes screen color to red and char color to green.

I'm trying my register changes based on this word.

 

 

Edited July 3, 2021 by GDMike