Camel99 Forth Information goes here

[+Lee Stewart]

2 hours ago, RXB said:

Yea guys I just think reading the CRU lines 6 to 14 would be faster as you just look for a non zero value for a key pressed.

No key pressed would mean those 4 bits are zero, keypress would be a value depending on that value.

 

Actually (and counterintuitively!), the CRU bit for a pressed key is 0, so, for your logic to work, you would need to INVert the result returned by the STCR Assembly code instruction.

 

...lee

[+TheBF]

Thanks guys. I will do some work in this area.

I actually coded up the Thierry code a long time back to measure it.  It takes 9 ticks. So that's 5 times faster.  I never used it.

At that time I was on the hairy edge of exceeding my 8K program size and so I didn't go any further with it. 

I think I can figure out how to patch a new KEY routine into the system when the multi-tasker loads. This idea would make things more efficient for sure.

[RXB]

4 hours ago, Lee Stewart said:

 

Actually (and counterintuitively!), the CRU bit for a pressed key is 0, so, for your logic to work, you would need to INVert the result returned by the STCR Assembly code instruction.

 

...lee

Are you saying all CRU bits are set to one unless a key is pressed and that bit is zero?

This would be the opposite of every keyboard switch on planet.

As far as I know it has always been zero unless that switch is on, which is the opposite of what you stated above?

 

I think Editor Assembler Page 156 (TB) disagrees with this as it reads in "Application Notes:"

The CRU bit is transferred with no modification to the STATUS BYTE thus I think there is confusion between status and actual bit values.

 

Edited November 7, 2021 by RXB

[+TheBF]

Before I get to my key problems I had this crazy idea this morning since I have now some fluency with the graphics and multi-tasking functions.

 

This might make a neat screen saver.  

 

Spoiler

\ MYSTERIOUS EYES

INCLUDE DSK1.TOOLS  \ DEBUG ONLY

INCLUDE DSK1.DATABYTE
INCLUDE DSK1.MARKER
INCLUDE DSK1.GRAFIX
INCLUDE DSK1.RANDOM
INCLUDE DSK1.DIRSPRIT
INCLUDE DSK1.MTASK99

\ chopped into 4 pieces for smooth multi-tasking
: CHARDEF4 ( data[] ascii# -- )
        >R    ( hold ascii# on Rstack like a local variable)
            DUP R@     CHARDEF   PAUSE
        8 + DUP R@ 1+  CHARDEF   PAUSE
        8 + DUP R@ 2+  CHARDEF   PAUSE
        8 +     R> 3 + CHARDEF   PAUSE
;

\ ****************************************
\ * Sprite Patterns
\ ****************************************
HEX
CREATE EYELIDS
  DATA 030C,1020,4040,8080    \ 0 Wide open
  DATA 8080,4040,2010,0C03    \
  DATA C030,0804,0202,0101    \
  DATA 0101,0202,0408,30C0    \

  DATA 030F,1F3F,4040,8080    \
  DATA 8080,4040,2010,0C03    \
  DATA C0F0,F8FC,0202,0101    \
  DATA 0101,0202,0408,30C0    \

  DATA 030F,1F3F,7F7F,8080    \
  DATA 8080,4040,2010,0C03    \
  DATA C0F0,F8FC,FEFE,0101    \
  DATA 0101,0202,0408,30C0    \

  DATA 030F,1F3F,7F7F,FFFF    \
  DATA 8080,4040,2010,0C03    \
  DATA C0F0,F8FC,FEFE,FFFF    \
  DATA 0101,0202,0408,30C0    \

  DATA 030F,1F3F,7F7F,FFFF    \
  DATA FFFF,4040,2010,0C03    \
  DATA C0F0,F8FC,FEFE,FFFF    \
  DATA FFFF,0202,0408,30C0    \

  DATA 030F,1F3F,7F7F,FFFF    \
  DATA FFFF,7F7F,2010,0C03    \
  DATA C0F0,F8FC,FEFE,FFFF    \
  DATA FFFF,FEFE,0408,30C0    \

  DATA 030F,1F3F,7F7F,FFFF    \
  DATA FFFF,7F7F,3F1F,0C03    \
  DATA C0F0,F8FC,FEFE,FFFF    \
  DATA FFFF,FEFE,FCF8,30C0    \

  DATA 030F,1F3F,7F7F,FFFF    \
  DATA FFFF,7F7F,3F1F,0F03    \
  DATA C0F0,F8FC,FEFE,FFFF    \
  DATA FFFF,FEFE,FCF8,F0C0    \ 7 FULLY CLOSED

DECIMAL
: ]EYELID  32 * EYELIDS + ;

CREATE PUPIL
HEX
  DATA 0000,0000,0001,0307
  DATA 0707,0301,0000,0000
  DATA 0000,0000,00C0,E0F0
  DATA F0F0,E0C0,0000,0000


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
DECIMAL

128 CONSTANT LEFTEYE
132 CONSTANT RIGHTEYE

136 CONSTANT LEFTPUPIL
140 CONSTANT RIGHTPUPIL

144 CONSTANT SCLERA     ( the white part of the eye)

VARIABLE FATIGUE    12 FATIGUE !
VARIABLE NERVOUS    40 NERVOUS !

: BLINKER   FATIGUE @ MS  ;
: NERVES    NERVOUS @ MS  ;

: CLOSE1 ( char --) 8 0 DO  I ]EYELID OVER CHARDEF4 BLINKER      LOOP DROP ;
: OPEN1  ( char --) 0 7 DO  I ]EYELID OVER CHARDEF4 BLINKER  -1 +LOOP DROP ;

: BLINK1   ( char -- )  DUP CLOSE1 OPEN1 ;

: CLOSE2  ( -- )
    8 0 DO
        I ]EYELID DUP
        LEFTEYE  CHARDEF4
        RIGHTEYE CHARDEF4
        BLINKER
    LOOP ;

: OPEN2  ( -- )
    0 7 DO
        I ]EYELID DUP
        LEFTEYE  CHARDEF4
        RIGHTEYE CHARDEF4
        BLINKER
    -1 +LOOP ;

: BLINK2     CLOSE2 OPEN2 ;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
CREATE EYE-XY  0 , 0 ,
EYE-XY    CONSTANT EROW
EYE-XY 2+ CONSTANT ECOL

: PIX.COL ( -- n)   ECOL @ 8* ;
: PIX.ROW ( -- n)   EROW @ 8* 1- ;

: DEF.CHARS
  0 ]EYELID  LEFTEYE  CHARDEF4
  0 ]EYELID  RIGHTEYE CHARDEF4

  PUPIL LEFTPUPIL  CHARDEF4
  PUPIL RIGHTPUPIL CHARDEF4

  7 ]EYELID SCLERA CHARDEF4   ( define a white circle in 4 chars )
   SCLERA SET# 16 1 COLOR     ( make it white)
  2 MAGNIFY ;

: .EYELIDS
( char  colr    x             y       sp# -- )
   128   2    PIX.COL      PIX.ROW    0  SPRITE \ left eye
   132   2    PIX.COL 32 +  PIX.ROW   1  SPRITE \ left right
;

: .PUPILS
   136   2    PIX.COL      PIX.ROW    2  SPRITE \ left pupil
   140   2    PIX.COL 32 +  PIX.ROW   3  SPRITE \ right pupil
;

: .SCLERA  ( col row --)
       2DUP AT-XY  144 EMIT 146 EMIT
         1+ AT-XY  145 EMIT 147 EMIT ;

: .2SCLERA  ( --)
        VROW 2@ 2>R  \ save cursor position
        EYE-XY 2@  .SCLERA
        EYE-XY 2@ SWAP 4 + SWAP .SCLERA
        2R> AT-XY  ; \ restore

: .EYES   ( col row -- )
           EYE-XY 2! .2SCLERA  .EYELIDS  .PUPILS ;

: ?GAZE   ( n -- n )  DUP  5 -4 WITHIN ABORT" Ouch!" ;
: SP.X+!  ( n spr# --) ?GAZE  SP.X DUP>R VC@ + R> VC! ;
: SP.Y+!  ( n spr# --) ?GAZE  SP.Y DUP>R VC@ + R> VC! ;

: HORZ    ( offset -- )   DUP 2 SP.X VC!  32 +  3 SP.X VC! ;
: VERT    ( height -- )   DUP 2 SP.Y VC!  3 SP.Y VC! ;

: CENTER  ( -- )
       PIX.COL  HORZ
       PIX.ROW  VERT ;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ TASKS
: BLINKING ( -- )
         BEGIN
           4000 RND 250 + MS
           BLINK2
         AGAIN ;

: LEFT/RIGHT
         BEGIN
           3000 RND 250 + MS
           PIX.COL  8 RND 4 - +  HORZ
         AGAIN ;

: UP/DOWN
         BEGIN
           4000 RND 500 + MS
           PIX.COL  8 RND 4 - +  VERT
         AGAIN ;

CREATE JOB1  USIZE ALLOT   JOB1 FORK
CREATE JOB2  USIZE ALLOT   JOB2 FORK
CREATE JOB3  USIZE ALLOT   JOB3 FORK

 ' BLINKING    JOB1 ASSIGN
 ' LEFT/RIGHT  JOB2 ASSIGN
 ' UP/DOWN     JOB3 ASSIGN

: GO
      PAGE
      DEF.CHARS
      10 10 .EYES
      0 0 AT-XY

      JOB1 WAKE
      JOB2 WAKE
      JOB3 WAKE 
;

 

 

[+mizapf]

1 hour ago, RXB said:

Are you saying all CRU bits are set to one unless a key is pressed and that bit is zero?

This would be the opposite of every keyboard switch on planet.

The keys close contact to 0V (from the 74LS138 selector), so the bit value is exactly the logical level. 1 = open, 0 = closed.

Closing to 0V (GND) is a very common concept.

[RXB]

40 minutes ago, mizapf said:

The keys close contact to 0V (from the 74LS138 selector), so the bit value is exactly the logical level. 1 = open, 0 = closed.

Closing to 0V (GND) is a very common concept.

Hmmm last I checked in electronics:

Open means OFF  or zero for no voltage passed.

Closed means ON or one for votage is passed.

Unless bit values are reversed so 1 is off and 0 is on, but I have never seen that.

 

Closed, Open, and Short Circuits - dummies

 

Ok so you are saying Lee is right, but since when has 1 in the return of the CRU bit meant off?

Looking at charts of CRU they indicate 1 for activation and you are saying the opposite that activation is 0?

How come the CRU bit value is 1 but you say 0? 

Edited November 7, 2021 by RXB

[+mizapf]

If you have a look at common microcontroller I/O port usage, the usual way is to pull up the input via a resistor, and then use a switch or key and let it close to 0, thus pulling down the input. This is exactly what is done with the TI keyboard: Pressing a key closes the path to 0 (which is selected by the 74LS138, which itself is controlled by three CRU bits).

 

So the 1 (open) and 0 (closed) of the key is fed into the 9901, and this is what you read by STCR or TB.

[+Lee Stewart]

1 hour ago, RXB said:

     Are you saying all CRU bits are set to one unless a key is pressed and that bit is zero?

This would be the opposite of every keyboard switch on planet.

As far as I know it has always been zero unless that switch is on, which is the opposite of what you stated above?

     I think Editor Assembler Page 156 (TB) disagrees with this as it reads in "Application Notes:"

The CRU bit is transferred with no modification to the STATUS BYTE thus I think there is confusion between status and actual bit values.

 

11 minutes ago, RXB said:

Hmmm last I checked in electronics:

Open means OFF  or zero for no voltage passed.

Closed means ON or one for votage is passed.

Unless bit values are reversed so 1 is off and 0 is on, but I have never seen that.

Closed, Open, and Short Circuits - dummies

 

Your protestations to the contrary notwithstanding, the fact remains that CRU bits for the keyboard are

• 1 = key up
• 0 = key down (pressed)

The E/A page you reference says nothing about the values of keyboard CRU bits. It is talking about CRU bits in general. It says that CRU bits are transferred unchanged. The bit values can be 0 or 1. You have apparently never read the keyboard CRU bits with your own Assembly code. If you look at the code for the console’s KSCAN, you will see (at  address >0344)

        SETO R4               INVERT FOLLOWS
        STCR R4,8             STORE KBD OUTPUTS
        INV  R4               MAKE ANY STROBE A 1
        MOV  R1,R1            LAST KBD STROBE
        JNE  C354             NO
        MOVB R4,R7            SAVE BITS FROM KBD
        ANDI R4,>0F00

Notice the INV instruction after the keyboard CRU bits are read and the comment (from TI programmers) to its right.

 

...lee

[+TheBF]

Ok I cleaned up the code. There was a lot of unused cruft in there.  

I also made an E/A5 program so there a little screen saver for everyone.

 

For some strange reason I find to funny to have these eyes looking around from inside my computer.

 

Things I learned:

You must run INIT-MULTI  in your startup code if you want to run the multi-tasker. DUH! 

It runs automatically when you compile the multi-tasker.  I just write the stuff. I don't know how to USE it.  

(See GO in the code)

 

This version uses only 2 extra tasks and the console task handles the up/down eye motion.

 

 

Spoiler

\ MYSTERIOUS EYES

\ INCLUDE DSK1.TOOLS  \ DEBUG ONLY

INCLUDE DSK1.DATABYTE
INCLUDE DSK1.MARKER
INCLUDE DSK1.GRAFIX
INCLUDE DSK1.RANDOM
INCLUDE DSK1.DIRSPRIT
INCLUDE DSK1.MTASK99

DECIMAL
: CHARDEF4 ( data[] ascii# -- ) PAUSE  ]PDT 32 VWRITE ;

\ ****************************************
\ * Sprite Patterns
\ ****************************************
HEX
CREATE EYELIDS
  DATA 030C,1020,4040,8080    \ 0 Wide open
  DATA 8080,4040,2010,0C03
  DATA C030,0804,0202,0101
  DATA 0101,0202,0408,30C0

  DATA 030F,1F3F,4040,8080
  DATA 8080,4040,2010,0C03
  DATA C0F0,F8FC,0202,0101
  DATA 0101,0202,0408,30C0

  DATA 030F,1F3F,7F7F,8080
  DATA 8080,4040,2010,0C03
  DATA C0F0,F8FC,FEFE,0101
  DATA 0101,0202,0408,30C0

  DATA 030F,1F3F,7F7F,FFFF
  DATA 8080,4040,2010,0C03
  DATA C0F0,F8FC,FEFE,FFFF
  DATA 0101,0202,0408,30C0

  DATA 030F,1F3F,7F7F,FFFF
  DATA FFFF,4040,2010,0C03
  DATA C0F0,F8FC,FEFE,FFFF
  DATA FFFF,0202,0408,30C0

  DATA 030F,1F3F,7F7F,FFFF
  DATA FFFF,7F7F,2010,0C03
  DATA C0F0,F8FC,FEFE,FFFF
  DATA FFFF,FEFE,0408,30C0

  DATA 030F,1F3F,7F7F,FFFF
  DATA FFFF,7F7F,3F1F,0C03
  DATA C0F0,F8FC,FEFE,FFFF
  DATA FFFF,FEFE,FCF8,30C0

  DATA 030F,1F3F,7F7F,FFFF
  DATA FFFF,7F7F,3F1F,0F03
  DATA C0F0,F8FC,FEFE,FFFF
  DATA FFFF,FEFE,FCF8,F0C0    \ 7 FULLY CLOSED

DECIMAL
: ]EYELID  32 * EYELIDS + ;

CREATE PUPIL
HEX
  DATA 0000,0000,0001,0307
  DATA 0707,0301,0000,0000
  DATA 0000,0000,00C0,E0F0
  DATA F0F0,E0C0,0000,0000


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
DECIMAL

128 CONSTANT LEFTEYE
132 CONSTANT RIGHTEYE

136 CONSTANT LEFTPUPIL
140 CONSTANT RIGHTPUPIL

144 CONSTANT SCLERA     ( the white part of the eye)

VARIABLE FATIGUE    18 FATIGUE !
VARIABLE CALM       90 CALM    !

: BLINKER   FATIGUE @ MS  ;
: CLOSE2  ( -- )
    8 0 DO
        I ]EYELID DUP
        LEFTEYE  CHARDEF4
        RIGHTEYE CHARDEF4
        BLINKER
    LOOP ;

: OPEN2  ( -- )
    0 7 DO
        I ]EYELID DUP
        LEFTEYE  CHARDEF4
        RIGHTEYE CHARDEF4
        BLINKER
    -1 +LOOP ;

: BLINK2     CLOSE2 OPEN2 ;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
CREATE EYE-XY  0 , 0 ,
EYE-XY    CONSTANT EROW
EYE-XY 2+ CONSTANT ECOL

: PIX.COL ( -- n)   ECOL @ 8* ;
: PIX.ROW ( -- n)   EROW @ 8* 1- ;

: DEF.CHARS
  0 ]EYELID  LEFTEYE  CHARDEF4
  0 ]EYELID  RIGHTEYE CHARDEF4

  PUPIL LEFTPUPIL  CHARDEF4
  PUPIL RIGHTPUPIL CHARDEF4

  7 ]EYELID SCLERA CHARDEF4   ( define a white circle in 4 chars )
   SCLERA SET# 16 1 COLOR     ( make it white)
  2 MAGNIFY ;

: .EYELIDS
( char  colr    x             y       sp# -- )
    CLOSE2
   128   2    PIX.COL      PIX.ROW    0  SPRITE \ left eye
   132   2    PIX.COL 32 +  PIX.ROW   1  SPRITE \ left right
;

: .PUPILS
( char  colr     x             y      sp# -- )
   136   5     PIX.COL      PIX.ROW    2  SPRITE \ left pupil
   140   5     PIX.COL 32 +  PIX.ROW   3  SPRITE \ right pupil
;

: .SCLERA  ( col row --)
       2DUP AT-XY  144 EMIT 146 EMIT
         1+ AT-XY  145 EMIT 147 EMIT ;

: .2SCLERA  ( --)
        VROW 2@ 2>R  \ save cursor position
        EYE-XY 2@  2DUP .SCLERA
        SWAP 4 + SWAP .SCLERA
        2R> AT-XY  ; \ restore

: .EYES   ( col row -- ) EYE-XY 2! .2SCLERA  .EYELIDS  .PUPILS ;
: HORZ    ( offset -- )  DUP 2 SP.X VC!  32 +  3 SP.X VC! ;
: VERT    ( height -- )  DUP 2 SP.Y VC!  3 SP.Y VC! ;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ TASKS
: BLINKING ( -- )
         BEGIN
           4000 RND FATIGUE @ + MS
           BLINK2
         AGAIN ;

: LEFT/RIGHT
         BEGIN
           2000 RND CALM @ + MS
           PIX.COL  8 RND 4 - +  HORZ
         AGAIN ;

: UP/DOWN
         BEGIN
           3000 RND CALM @ + MS
           PIX.COL  8 RND 5 - +  VERT
          ?TERMINAL ABORT" Forth"
         AGAIN ;

CREATE JOB1  USIZE ALLOT
CREATE JOB2  USIZE ALLOT
HEX 83D6 CONSTANT SCR-TIMER

DECIMAL
: GO
      GRAPHICS
      DEF.CHARS
      10 10 .EYES
      0 0 AT-XY
      INIT-MULTI
      JOB1 FORK  JOB2 FORK
      ['] BLINKING    JOB1 ASSIGN
      ['] LEFT/RIGHT  JOB2 ASSIGN
      JOB1 RESTART  JOB2 RESTART
      SCR-TIMER ON
      MULTI
      UP/DOWN
;

HERE ORGDP !
LATEST @ ORGLAST !

INCLUDE DSK1.SAVESYS

' GO SAVESYS DSK5.EYES

 

 

EYES.zip

[+TheBF]

Backing Thinkwards

 

Just read this article about an problem solving methodology that I had never heard of. 

https://newsletter.butwhatfor.com/p/invert-always-invert-avoid-failure

 

The article describes solving problems by actively searching for ways that will fail. I never thought of it quite so brutally but it reminds of something I said once at a Forth conference and Elizabeth Rather and a few others looked at me like I was out of my mind.

 

I said: "Forth let's me make more mistakes per minute" 

 

By that I meant that by cutting programs into tiny pieces that could be tested in seconds interactively, I could make a lot of mistakes in a short time and therefore could find the best solution faster.

Looks like I didn't invent the concept.  

 

[GDMike]

Absolutely. I love the ability for flexible scenario calculating.  Sometimes I find myself  placing too much information into my code because I assume I know some of the answer and it's results, and I have to slow down and let forth do the assuming. 

How do I know that? Because my word is like 10 or more lines and growing without creating another word and my comments say, this is already known...lol

 

Edited November 9, 2021 by GDMike

[+TheBF]

Exactly.  10 or more lines is normal for other languages but can get hard to read in Forth.

 

I read that after Chuck Moore saw how other people wrote Forth code he said something like "Maybe not everybody should use Forth"  :) 

I got the sense that he was shocked by what he saw. 

 

Oh well us mere mortals will just have to carry on. 

 

[GDMike]

I'm good in small steps anyway and prefer it, but not so small as assembly makes it...at that point I'm like, do I really have to clear this register and the next and the one sitting next to that one.. uhhhahrhgg!!!

[+TheBF]

Over on Reddit r/Forth a bunch of people found a game from Byte Magazine written in Forth in 1982.

 

Byte Magazine Volume 07 Number 12 - Game Plan 1982 : Free Download, Borrow, and Streaming : Internet Archive 

 

It was for some Forth that ran on 6502. Rick Carlino translated it into something the runs on GForth. 

It wasn't too hard to make ANS GForth code run on ANS Camel Forth but it is still kind of ugly.

Actually I can tell that the original author was still getting his head around Forth because the factoring is not good.

 

Anyway I put it up here and will see what I can do to make it into something fun for TI-99.

 

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

[+TheBF]

Well trying to improve 39 year old software is rather time consuming...

 

But I have something that is getting closer to playable.

Some people have got Cosmic conquest running on 6502 emulators but it has been a challenge from what I am told.

We know it ran on a Fig Forth dialect but we don't which one.

Nobody seems to know how to interpret the graphics definitions in the program so I just punted and made my own.

 

I took my first look at the code last Monday.  When I regained consciousness... 

I decided it needed some Forthifying cuz it looked a lot like BASIC written in Forth syntax. 

That works fine in BASIC but it makes Forth harder to read and Forth doesn't need any help in that department.  

 

Here is a sample:

: BUY    ( purchasing of ships at planet)
   BUY-V @ 0=
   IF    ( it's ok to buy)
      5 BUY-V !               ( stop continous buying)
      RANDOM1 5 / XY@ INFO1 C@ 10 / + 1+ DUP TEMP1 !
      10 0 VHTAB ." COST PER SHIP = " 2 .R
      12 0 VHTAB ." HOW MANY DO YOU WANT?" INPUT
      CREDIT @ TEMP1 @ / MIN    ( no more than he can afford)
      DUP 3 F @ + 3 F !       ( update ships in fleet)
      TEMP1 @ * CREDIT @ SWAP - CREDIT !  ( update credit)
      16 1 F C@ 2 F C@ GALAXY C!  ( make sure fleet symbol there)
   ELSE
      10 0 VHTAB ." NO SHIPS AVAILABLE"
   ENDIF ;

"F" is the name of an array. Not good form, since "F" is also a valid HEX number.

And so on...

 

It actually wants a complete re-write to be a better Forth program but I will settle for band-aids. 

 

 

I still don't have my head around one aspect of the data that manages two fleets for the player but it mostly works now and I can make changes easier now.

It is coming in at over 900 lines.

 

The full thing is here with a screen shot.

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

 

Its a very old game and a little boring by today's standards. I want to stay true to the original but I think I have to add some sound effects.

I already added beeps and honk.

When I finally get there I will build a binary and people can beat it up. 

 

 

 

 

[+TheBF]

I had to take my head out of that game for a while.  :) 

 

I explored the key discussion we had earlier and it started to come back to me that one problem I had before was it took a while for the fast key detection code to clear the last key pressed.

I added FLUSHKEY to wait until the mechanism is clear. 

 

This code seems to work ok and would only add 140 bytes to the multi-tasking system so it might be worth making it the default.

 

The only caveat is that FLUSHKEY would have to be run before the program starts. 

I have not yet tried patching this into the main KEY routine in Forth.  That's the next part of the job. 

\ FASTKEY is better for multi-tasking

\ KSCAN in the system ROM uses internal delays for debounce.
\ It takes 1.2 mS to run even if no key is pressed!
\ This slows down cooperative multi-tasking by slowing down
\ the context switch time while waiting for a key keypress.


NEEDS WORDLIST FROM DSK1.SUPERTOOLS

\ Source:
\ http://www.unige.ch/medecine/nouspikel/ti99/keyboard.htm#quick%20scan

FORTH DEFINITIONS ALSO ASSEMBLER
HERE
HEX
CODE (KEY?) ( -- ?)      \ return TRUE if any key pressed
      TOS PUSH,          \
      TOS CLR,           \ TOS=false
      R1 CLR,            \ Start with column 0
      BEGIN,
         R12 0024 LI,    \ R12-address for column selection
         R1  0003 LDCR,  \ Select a column
         R12 0006 LI,    \ R12-address to read rows
               R2 SETO,  \ Make sure all bits are 1
         R2  0008 STCR,  \ read 8 row values
               R2 INV,   \ pressed keys read as 0 so flip all bits
         NE IF,          \ A key was pressed
             TOS SETO,   \ Set TOS true for Forth
             NEXT,       \ return to Forth
         ENDIF,
         R1 0100 AI,     \ Next column
         R1 0600 CI,     \ Are we done?
      EQ UNTIL,
      NEXT,              \ Return to Forth
 ENDCODE

: FLUSHKEY  ( -- ) \ make sure no key is pressed
    BEGIN
    (KEY?) WHILE
    REPEAT ;

: WAITKEY   ( -- )
    BEGIN
        PAUSE               \ Essential for Multi-tasking with Console
        CURS @              \ fetch 2 char cursor (space & _ )
        TMR@ 1FFF < IF >< THEN VPUT  \ swap cursor bytes & write
       (KEY?)
    UNTIL ;

\ over-write the old version
: KEY  ( -- c)  WAITKEY  KEY ;

HERE SWAP - DECIMAL .  .( bytes)

: TEST1
        FLUSHKEY
        BEGIN
            KEY  EMIT
           ?TERMINAL
        UNTIL ;

 

[+TheBF]

The assembled coding talent in this forum just blows my mind.

 

I was away for a few days and started looking at Time Pilot source code by @retroclouds 

So wonderful to read it. 

 

One of the downsides of working in Forth is the constant need to re-invent the wheel or doing a lot of translating of source code since Forth is unusual.

 

I saw the KONAMI font in the Time Pilot source code and realized I could adapt that pretty quickly with DATABYTE library.

So here is how to "borrow" fonts from Assembler projects and use them in Camel99. 

We don't need the '>' character. A little search and replace fixed it up.

Then we just needed a bit of editing to get something that works. 

 

In this case we are recording the data in expansion RAM like the original program did.

 

Each block of data is given a name in the Forth dictionary with the CREATE word.

At the bottom we use the interpreter to write the data blocks into VDP RAM and 

then compile a short TEST word to see how it looks. 

\ Taken from TIME PILOT SOURCE CODE, translated for CAMEL99 FORTH
\ ***************************************************************
\ * KONAMI Game Font - from Konami's Athletic Land for MSX
\ * Letter A-Z
\ ****************************************************************
INCLUDE DSK1.DATABYTE
INCLUDE DSK1.GRAFIX

HEX
CREATE KONAMI
      BYTE  00,1C,36,63,63,7F,63,63    \     A
      BYTE  00,7E,63,63,7E,63,63,7E    \     B
      BYTE  00,3E,63,60,60,60,63,3E    \     C
      BYTE  00,7C,66,63,63,63,66,7C    \     D
      BYTE  00,7F,60,60,7E,60,60,7F    \     E
      BYTE  00,7F,60,60,7E,60,60,60    \     F
      BYTE  00,3E,63,60,67,63,63,3F    \     G
      BYTE  00,63,63,63,7F,63,63,63    \     H
      BYTE  00,3C,18,18,18,18,18,3C    \     I
      BYTE  00,1F,06,06,06,06,66,3C    \     J
      BYTE  00,63,66,6C,78,7C,6E,67    \     K
      BYTE  00,60,60,60,60,60,60,7F    \     L
      BYTE  00,63,77,7F,7F,6B,63,63    \     M
      BYTE  00,63,73,7B,7F,6F,67,63    \     N
      BYTE  00,3E,63,63,63,63,63,3E    \     O
      BYTE  00,7E,63,63,63,7E,60,60    \     P
      BYTE  00,3E,63,63,63,6F,66,3D    \     Q
      BYTE  00,7E,63,63,62,7C,66,63    \     R
      BYTE  00,3E,63,60,3E,03,63,3E    \     S
      BYTE  00,7E,18,18,18,18,18,18    \     T
      BYTE  00,63,63,63,63,63,63,3E    \     U
      BYTE  00,63,63,63,63,36,1C,08    \     V
      BYTE  00,63,63,6B,6B,7F,77,22    \     W
      BYTE  00,63,76,3C,1C,1E,37,63    \     X
      BYTE  00,66,66,7E,3C,18,18,18    \     Y
      BYTE  00,7F,07,0E,1C,38,70,7F    \     Z

\ ***************************************************************
\ * KONAMI Game Font - from Konami's Athletic Land for MSX
\ * Digits 0-9, SPACE and HYPHEN
\ ***************************************************************
CREATE KONAMI#
      BYTE  00,1C,22,63,63,63,22,1C    \     0
      BYTE  00,18,38,18,18,18,18,7E    \     1
      BYTE  00,3E,63,03,0E,3C,70,7F    \     2
      BYTE  00,3E,63,03,0E,03,63,3E    \     3
      BYTE  00,0E,1E,36,66,66,7F,06    \     4
      BYTE  00,7F,60,7E,63,03,63,3E    \     5
      BYTE  00,3E,63,60,7E,63,63,3E    \     6
      BYTE  00,7F,63,06,0C,18,18,18    \     7
      BYTE  00,3E,63,63,3E,63,63,3E    \     8
      BYTE  00,3E,63,63,3F,03,63,3E    \     9
      BYTE  00,00,00,00,00,00,00,00    \     SPACE
      BYTE  00,00,00,7E,00,00,00,00    \     -

DECIMAL
KONAMI   CHAR A ]PDT  26 8* VWRITE
KONAMI#  CHAR 0 ]PDT  12 8* VWRITE

: TEST
     PAGE ." WE HAVE KONAMI FONT"
     CR
     CR   ." FOR CAMEL99 FORTH"
     KEY DROP
;

 

Alternatively after loading the code above, we could save this VDP RAM data as font file and load it on program start. 

INCLUDE DSK1.LOADSAVE 
S" DSK3.KONAMI" SAVE-FONT

 

 

[+TheBF]

Over on the "Substantial Programs in Forth" topic, we were talking about a demo program suggested by @neglectoru

The demo program needed to deal with time and it made me realize that I didn't have a time module in my library files.

So here is one that gives some degree of versatility.

 

I have opted to use a the stack order: ( -- sec mins hrs ) because it's faster to convert back and forth to seconds.

However there are also two words that let you change that order to ( -- hrs mins sec) and another to switch back so the bases are covered. 

 

In our discussion over in the other topic @neglectoru was struggling with the how in the heck you could manage all those stack elements for dates and times in Forth.

It is true that variables can make some things much simpler but in this case I think factoring allowed us to do the job without too much mental strain.

 

I opted to not pull-in the entire doubles library and just used the CORE Forth words in the kernel plus D=  and DU<  defined here.

 

I have a DATE library that is borrowed from the work of the late great Neil Baud (aka Wil Baden) in the second spoiler. 

It lets us calculate the "century day" so we can compare dates for before and after and also from the century-day we can compute the day of the week. 

With these two little files we could continue to flesh out the calendar application.  

 

TIME.FTH

Spoiler

\ TIME.FTH   time utilities for Camel99 Forth      Nov 24 2012 Brian Fox

\ 32 bit integer we can manage up to 2^32 seconds, or  119304 hrs.

\ INCLUDE DSK1.TOOLS  \ debugging

DECIMAL
: HRS>MINS  ( n -- d) 3600 UM* ;
: MINS>SECS ( n -- d) 60 UM* ;

\ stackcrobatics for 3 items (hours,minutes,seconds)
: >SSMMHH ( h m s -- s m h)  SWAP ROT ;
: >HHMMSS ( s m h -- h m s)  -ROT SWAP ;

: TIME>D  ( s m h -- d)     \ convert time format to DOUBLE (32bit int)
        HRS>MINS  2>R       \ push double to rstack
        MINS>SECS SWAP M+   \ add secs (single) to mins (double) with mixed +
        2R> D+ ;            \ add hrs to sub-total

: D>TIME  ( d -- s m h )    \ convert DOUBLE to time
        3600 UM/MOD ( -- rem hrs) >R
        60 /MOD     ( -- secs mins)
        R> ;        ( -- secs mins hrs)

\ Concept from Starting Forth, Brodie. Would have never thought of this :)
: SEXTAL   6 BASE ! ;
: <:>     [CHAR] : HOLD ;
: <.>     [CHAR] . HOLD ;
: ##:     # SEXTAL # DECIMAL <:> ;

: .TIME   ( d -- ) \ expects double int as time in seconds on stack
          BASE @ >R
          <#  ##: ##:  # #  #> TYPE
          R> BASE ! ;

: DU<  ( d d -- ?) ROT U> IF 2DROP TRUE   ELSE U<  THEN ;
: D=   ( d d -- ?) ROT = -ROT = AND ;

: REDUCE2  ( s m h s m h -- d1 d2) \ convert 2 times into 2 doubles
         TIME>D 2>R  \ convert top time and push
         TIME>D 2R>  \ convert and pop
;

: ISBEFORE ( s m h  s m h -- ?) REDUCE2 DU< ; \ is 1st time before 2nd time
: ISAFTER  ( s m h  s m h -- ?) REDUCE2 2SWAP DU< ; \ is 1st time after 2nd time
: SAMETIME ( s m h  s m h -- ?) REDUCE2 D= ;  \ are both times the same

 

 

 

DATE.FTH 

Spoiler

\ DATES.FTH   for Camel99 Forth            2019 Fox
\ changed to create strings for more flexibility

\ INCLUDE DSK1.TOOLS

DECIMAL

\ "This is an algorithm I've carried with me for 35 years,
\  originally in Assembler and Fortran II."
\  It counts the number of days from March 1, 1900."
\                                    Wil Baden R.I.P

: UNDER+  ( a b c -- a+c b )  ROT + SWAP ;

\ *****************************************************
\ **WARNING** only good until 2078 on 16 bit machine **
\ *****************************************************
: CDAY    ( dd mm yyyy -- century_day )
      -3 UNDER+  OVER  0< 
      IF   12 UNDER+  1-   THEN
      1900 -  1461 4 */   SWAP 306 *  5 +  10 /  + +  ;


: DOW     ( cday -- day_of_week )
           2 + 7 MOD 1+ ;             ( 7 is Sunday)

 

 

I also have a very old file I made for HsForth, for date printing in different dates in misc. formats so let's recycle that.

It used to be together with DATES.FTH but in a small system let's keep them separate. 

 

Note:

I finally learned how to make these sequential string arrays work on 9900. 

I had to add ALIGNED to NTH$  because of course S, does an ALIGNED after it compiles a string into memory to keep on even address boundaries.  

 

DATEFORM.FTH

Spoiler

\ DATEFORM.FTH    date formatting words    02MAR91  FOX
\ Ported to Camel99 Forth Nov 24 2021

DECIMAL
\ compact string array. Uses count byte as link to next string.

: NTH$ ( $array n -- address len )
  0 ?DO  COUNT +  ALIGNED  LOOP COUNT ;

CREATE MONTHS
  S"  " S,    S" Jan" S,
  S" Feb" S,  S" Mar" S,
  S" Apr" S,  S" May" S,
  S" Jun" S,  S" Jul" S,
  S" Aug" S,  S" Sep" S,
  S" Oct" S,  S" Nov" S,
  S" Dec" S,  S"  "   S,

: ##     BASE@ >R 0 <#   # #  #> TYPE    R> BASE ! ;
: ####   BASE@ >R 0 <#  # # # # #> TYPE  R> BASE ! ;

: ]MONTH  ( n -- addr len)
       DUP 13 1 WITHIN ABORT" Bad month#"
       MONTHS SWAP NTH$ ;

: M/D/Y  ( dd mm yyyy -- )  >R  ## ." /" ## ." /"  R> #### ;
: Y-M-D ( dd mm yyyy -- )  #### ." -"  ## ." -" ## ;
: D.M.Y  ( dd mm yyyy -- )  >R SWAP  ## ." ." ## ." ."  R> #### ;
: USADATE ( dd mm yyyy -- )  >R ]MONTH TYPE SPACE  ##  ." ," R> #### ;
: FORTH-DATE ( d,m,y,-- )  >R SWAP ## ]MONTH TYPE R> ## ;

 

 

 

 

 

Edited November 25, 2021 by TheBF
BUGS fixed in ISAFTER, ISBEFORE

[neglectoru]

I won't pretend to understand the day of week magic, but I think it would be magical in any language.

 

This is neat library! I hope I motivated something useful.

[+TheBF]

1 minute ago, neglectoru said:

I won't pretend to understand the day of week magic, but I think it would be magical in any language.

 

This is neat library! I hope I motivated something useful.

Yes you did.

But... I just discovered the century day is giving me the wrong number!  And I cannot find the original site where I saw that code.

I am now trying to find information on how to calculate the number of days from any date.

What a hobby!  

 

[+TheBF]

So testing seems to be important in software. ?

I had never test Neils' century day program against another computation and either I copied it wrong (most likely) or it is not correct.

 

I had posted a Rossetta code solution using this so I have to revisit that and correct it.

The other solution in Forth uses Zeller's congruence and seems to be correct so that's my go to method for now.

 

Here is the new DATEFORM.FTH library.   I put it all in one file.

Spoiler

\ DATEFORM.FTH    date formatting words    02MAR91  FOX
\ Ported to Camel99 Forth Nov 24 2021
DECIMAL
\ From Rosseta Code
\ Zeller's Congruence for Julian Calendar.
: ZELLER ( m -- days since march 1 )
  9 + 12 MOD 1-   26 10 */ 3 + ;

: WEEKDAY ( d m y -- 0..6 )   \ Monday..Sunday
  OVER 3 < IF 1- THEN
  DUP    4 /
  OVER 100 / -
  OVER 400 / +  +
  SWAP ZELLER + +
  1+ 7 MOD ;

\ compact string array. Uses count byte as link to next string.
: NTH$ ( $array n -- address len )
  0 DO  COUNT +  ALIGNED  LOOP COUNT ;

CREATE MONTHS
  S"  " S,    S" Jan" S,
  S" Feb" S,  S" Mar" S,
  S" Apr" S,  S" May" S,
  S" Jun" S,  S" Jul" S,
  S" Aug" S,  S" Sep" S,
  S" Oct" S,  S" Nov" S,
  S" Dec" S,  0 ,

: ]MONTH  ( n -- addr len)
  DUP 13 1 WITHIN ABORT" Bad month#"
  MONTHS SWAP NTH$ ;

CREATE DAYS
  S"  " S,
  S" Monday" S,
  S" Tuesday" S,
  S" Wednesday" S,
  S" Thursday" S,
  S" Friday" S,
  S" Saturday" S,
  S" Sunday" S,
  0 ,

: ]DAY ( n --) DAYS SWAP 1+ DUP 7 1 WITHIN ABORT" Bad day#"  NTH$ ;

: ##     BASE@ >R 0 <#   # #  #>   TYPE  R> BASE ! ;
: ####   BASE@ >R 0 <#  # # # # #> TYPE  R> BASE ! ;

: 3DUP    2 PICK 2 PICK 2 PICK ;

: .M/D/Y      ( dd mm yyyy -- ) >R  ## ." /" ## ." /"  R> #### ;
: .Y-M-D      ( dd mm yyyy -- ) #### ." -"  ## ." -" ## ;
: .D.M.Y      ( dd mm yyyy -- ) >R SWAP  ## ." ." ## ." ."  R> #### ;
: .USADATE    ( dd mm yyyy -- ) >R ]MONTH TYPE SPACE  ##  ." , " R> #### ;
: .FORTH-DATE ( dd mm yyyy -- ) >R SWAP ## ]MONTH TYPE R> ## ;

: .LONG-DATE ( dd mm yyyy -- )
  3DUP WEEKDAY ]DAY TYPE ." , " >R  ]MONTH TYPE SPACE ## ." , " R> .
;

 

 

I had no idea date manipulation was so complicated.  

 

 

[+TheBF]

I spent some time reviewing files for a Github refresh and found this "THEMATRIX" demo screen saver.

It also is a good demo of how to spawn tasks in low RAM at startup time so you don't take program space the task memory.

 

I think it looks better now and the screen doesn't timeout now (duh!)  so I made it into a binary program and it could be a cute screen saver.  

 

Spoiler

\ THE MATRIX Multi-tasking demonstration                Brian Fox 2021

\ NEEDS DUMP   FROM DSK1.TOOLS  \ DEBUG
NEEDS MARKER FROM DSK1.MARKER
NEEDS MALLOC FROM DSK1.MALLOC
NEEDS RND    FROM  DSK1.RANDOM
NEEDS COLOR  FROM DSK1.GRAFIX
NEEDS SPRITE FROM DSK1.DIRSPRIT
NEEDS FORK   FROM DSK1.MTASK99

: HEX#, ( addr len  --) \ can be used for longstrings (128 bytes)
        BASE @ >R  \ save radix
        HEX               \ we are converting hex numbers in the string
        BEGIN
        DUP WHILE        \ while len<>0
            2DUP DROP 4  \ get 4 digits from left end of string
            NUMBER? ABORT" Bad number"  \ convert string to number
             ,           \ compile the integer into memory
            4 /STRING    \ cut 4 digits off left side of string
        REPEAT
        2DROP
        R> BASE !  \ restore radix
;

CREATE Japanese
DECIMAL
  S" 007E087E08300000"  HEX#,
  S" 007E020202027E00"  HEX#,
  S" 0044442404043800"  HEX#,
  S" 0000600464087000"  HEX#,
  S" 0004081030501000"  HEX#,
  S" 0028282828284400"  HEX#,
  S" 0000107C107C1000"  HEX#,
  S" 003C448404041800"  HEX#,
  S" 003C000000007E00"  HEX#,
  S" 003E020214080400"  HEX#,
  S" 0004040404043800"  HEX#,
  S" 0042424242023C00"  HEX#,
  S" 007C107C100C0000"  HEX#,
  S" 007C007C007C0000"  HEX#,
  S" 007C007C04380000"  HEX#,
  S" 007C44A404380800"  HEX#,
  S" 007E020438448000"  HEX#,
  S" 0020203824202000"  HEX#,
  S" 00107C1424480000"  HEX#,
  S" 00087C0808300000"  HEX#,
  S" 00407C4040403C00"  HEX#,
  S" 00007C007C106000"  HEX#,
  S" 00287C2808301400"  HEX#,
  S" 0060600404047800"  HEX#,
  S" 0054540404381400"  HEX#,
  S" 007C04281028C400"  HEX#,
  S" 007C040404043800"  HEX#,
  S" 0000107C04043800"  HEX#,
  S" 007C101010107C00"  HEX#,
  S" 00207C2420202000"  HEX#,
  S" 00107C0438540000"  HEX#,


\ : .JAPAN  CR  159 128 DO I EMIT LOOP ;  .JAPAN
\ : .JAPAN2  CR 207 176 DO I EMIT LOOP ;  .JAPAN2

176 128 - CONSTANT WHITECHAR  ( changes green character to white)
: >WHITE ( greenchar -- whitechar) WHITECHAR + ;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ : CLIP     ROT MIN MAX ;
: RNDCHAR ( -- c)  30 RND 128 +  ; \ returns green charset only
: RNDX    32 RND ;  \ 31 CLIP ;
: RNDLEN    19 RND 4 + ;

: VROW++  ( -- ) VROW DUP @ 1+ 23 MIN SWAP ! ;

: FALLING ( length col row  -- )
          AT-XY
          ( len ) 0
          ?DO
             PAUSE
             RNDCHAR VPUT
             VROW++
             RNDCHAR >WHITE VPUT
             60 RND 10 + MS
          LOOP
;

\ \\\\\\\\\\\\\\\\\\\\\ BACKGROUND TASKS ///////////////////
: FALLER
       BEGIN
         RNDLEN  RNDX  0 FALLING
       AGAIN ;

: ERASER
       BEGIN
          RNDX 0 AT-XY
          24 0
          DO
             PAUSE
             BL VPUT
             VROW++
             50 MS
          LOOP
       AGAIN ;

CREATE GREENS   13 , 3 , 4 ,
: RND-GREEN  ( -- n) 3 RND CELLS  GREENS + @ ;

: SPARKLER \ switches charsets to random greens, random times
      BEGIN
          16 RND-GREEN 1 COLOR  50 RND MS
          17 RND-GREEN 1 COLOR  50 RND MS
          18 RND-GREEN 1 COLOR  50 RND MS
          19 RND-GREEN 1 COLOR  50 RND MS
          20 RND-GREEN 1 COLOR  50 RND MS
          21 RND-GREEN 1 COLOR  50 RND MS
      AGAIN
;
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ SPAWN allocates USER area in Low RAM, FORKS,
\ sets the awake flag and assigns a Forth word to RUN
: SPAWN  ( xt -- )  USIZE MALLOC DUP FORK DUP WAKE  ASSIGN  ;

: SPAWN-JOBS ( --)
  ['] FALLER SPAWN
  ['] FALLER SPAWN
  ['] FALLER SPAWN
  ['] ERASER SPAWN
  ['] ERASER SPAWN
  ['] SPARKLER SPAWN
;


HEX 83D6 CONSTANT ALWAYS  \ screen timeout control

DECIMAL
: RUN
    GRAPHICS
    CLEAR
    1 SCREEN
    Japanese 128 ]PDT  30 8* VWRITE  \ GREEN charset
    Japanese 176 ]PDT  30 8* VWRITE  \ WHITE charset

    INIT-MULTI
    SPAWN-JOBS

    128 SET# 168 SET#  4 1 COLORS   ( green)
    176 SET# 228 SET# 16 1 COLORS   ( white)
    MULTI
    ALWAYS ON  \ prevent screen timeout
    BEGIN      \ the console task loops to test the break key 
      PAUSE
      ?TERMINAL
    UNTIL
    SINGLE
    8 SCREEN
    BL SET#  [CHAR] Z SET#  2 1 COLORS
    BYE
;

LOCK

INCLUDE DSK1.SAVESYS

' RUN SAVESYS DSK5.THEMATRIX

 

 

THEMATRIX.ZIP

[+arcadeshopper]

17 hours ago, TheBF said:

I spent some time reviewing files for a Github refresh and found this "THEMATRIX" demo screen saver.

It also is a good demo of how to spawn tasks in low RAM at startup time so you don't take program space the task memory.

 

I think it looks better now and the screen doesn't timeout now (duh!)  so I made it into a binary program and it could be a cute screen saver.  

 

  Reveal hidden contents

\ THE MATRIX Multi-tasking demonstration                Brian Fox 2021

\ NEEDS DUMP   FROM DSK1.TOOLS  \ DEBUG
NEEDS MARKER FROM DSK1.MARKER
NEEDS MALLOC FROM DSK1.MALLOC
NEEDS RND    FROM  DSK1.RANDOM
NEEDS COLOR  FROM DSK1.GRAFIX
NEEDS SPRITE FROM DSK1.DIRSPRIT
NEEDS FORK   FROM DSK1.MTASK99

: HEX#, ( addr len  --) \ can be used for longstrings (128 bytes)
        BASE @ >R  \ save radix
        HEX               \ we are converting hex numbers in the string
        BEGIN
        DUP WHILE        \ while len<>0
            2DUP DROP 4  \ get 4 digits from left end of string
            NUMBER? ABORT" Bad number"  \ convert string to number
             ,           \ compile the integer into memory
            4 /STRING    \ cut 4 digits off left side of string
        REPEAT
        2DROP
        R> BASE !  \ restore radix
;

CREATE Japanese
DECIMAL
  S" 007E087E08300000"  HEX#,
  S" 007E020202027E00"  HEX#,
  S" 0044442404043800"  HEX#,
  S" 0000600464087000"  HEX#,
  S" 0004081030501000"  HEX#,
  S" 0028282828284400"  HEX#,
  S" 0000107C107C1000"  HEX#,
  S" 003C448404041800"  HEX#,
  S" 003C000000007E00"  HEX#,
  S" 003E020214080400"  HEX#,
  S" 0004040404043800"  HEX#,
  S" 0042424242023C00"  HEX#,
  S" 007C107C100C0000"  HEX#,
  S" 007C007C007C0000"  HEX#,
  S" 007C007C04380000"  HEX#,
  S" 007C44A404380800"  HEX#,
  S" 007E020438448000"  HEX#,
  S" 0020203824202000"  HEX#,
  S" 00107C1424480000"  HEX#,
  S" 00087C0808300000"  HEX#,
  S" 00407C4040403C00"  HEX#,
  S" 00007C007C106000"  HEX#,
  S" 00287C2808301400"  HEX#,
  S" 0060600404047800"  HEX#,
  S" 0054540404381400"  HEX#,
  S" 007C04281028C400"  HEX#,
  S" 007C040404043800"  HEX#,
  S" 0000107C04043800"  HEX#,
  S" 007C101010107C00"  HEX#,
  S" 00207C2420202000"  HEX#,
  S" 00107C0438540000"  HEX#,


\ : .JAPAN  CR  159 128 DO I EMIT LOOP ;  .JAPAN
\ : .JAPAN2  CR 207 176 DO I EMIT LOOP ;  .JAPAN2

176 128 - CONSTANT WHITECHAR  ( changes green character to white)
: >WHITE ( greenchar -- whitechar) WHITECHAR + ;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ : CLIP     ROT MIN MAX ;
: RNDCHAR ( -- c)  30 RND 128 +  ; \ returns green charset only
: RNDX    32 RND ;  \ 31 CLIP ;
: RNDLEN    19 RND 4 + ;

: VROW++  ( -- ) VROW DUP @ 1+ 23 MIN SWAP ! ;

: FALLING ( length col row  -- )
          AT-XY
          ( len ) 0
          ?DO
             PAUSE
             RNDCHAR VPUT
             VROW++
             RNDCHAR >WHITE VPUT
             60 RND 10 + MS
          LOOP
;

\ \\\\\\\\\\\\\\\\\\\\\ BACKGROUND TASKS ///////////////////
: FALLER
       BEGIN
         RNDLEN  RNDX  0 FALLING
       AGAIN ;

: ERASER
       BEGIN
          RNDX 0 AT-XY
          24 0
          DO
             PAUSE
             BL VPUT
             VROW++
             50 MS
          LOOP
       AGAIN ;

CREATE GREENS   13 , 3 , 4 ,
: RND-GREEN  ( -- n) 3 RND CELLS  GREENS + @ ;

: SPARKLER \ switches charsets to random greens, random times
      BEGIN
          16 RND-GREEN 1 COLOR  50 RND MS
          17 RND-GREEN 1 COLOR  50 RND MS
          18 RND-GREEN 1 COLOR  50 RND MS
          19 RND-GREEN 1 COLOR  50 RND MS
          20 RND-GREEN 1 COLOR  50 RND MS
          21 RND-GREEN 1 COLOR  50 RND MS
      AGAIN
;
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ SPAWN allocates USER area in Low RAM, FORKS,
\ sets the awake flag and assigns a Forth word to RUN
: SPAWN  ( xt -- )  USIZE MALLOC DUP FORK DUP WAKE  ASSIGN  ;

: SPAWN-JOBS ( --)
  ['] FALLER SPAWN
  ['] FALLER SPAWN
  ['] FALLER SPAWN
  ['] ERASER SPAWN
  ['] ERASER SPAWN
  ['] SPARKLER SPAWN
;


HEX 83D6 CONSTANT ALWAYS  \ screen timeout control

DECIMAL
: RUN
    GRAPHICS
    CLEAR
    1 SCREEN
    Japanese 128 ]PDT  30 8* VWRITE  \ GREEN charset
    Japanese 176 ]PDT  30 8* VWRITE  \ WHITE charset

    INIT-MULTI
    SPAWN-JOBS

    128 SET# 168 SET#  4 1 COLORS   ( green)
    176 SET# 228 SET# 16 1 COLORS   ( white)
    MULTI
    ALWAYS ON  \ prevent screen timeout
    BEGIN      \ the console task loops to test the break key 
      PAUSE
      ?TERMINAL
    UNTIL
    SINGLE
    8 SCREEN
    BL SET#  [CHAR] Z SET#  2 1 COLORS
    BYE
;

LOCK

INCLUDE DSK1.SAVESYS

' RUN SAVESYS DSK5.THEMATRIX

 

 

THEMATRIX.ZIP 9.04 kB · 3 downloads

interesting it doesn't work in js99er.ner.. fine in classic99 though

 

[+TheBF]

Well that's concerning. I never play with that one.

 

I didn't do a full warm boot on the Forth system when I started it. It worked on Classic99 so I  moved on.

Can I give you another one to try?

 

 

 

[+TheBF]

TheMatrix II.

Slightly new internal code but with a proper WARM boot of the Forth system before starting the rest of the program.

I tried to improve the shimmering of the green letters and twinkle the white ones a little.

A few more threads. 

 

Spoiler

\ THE MATRIX Multi-tasking demonstration                Brian Fox 2021

\ NEEDS DUMP   FROM DSK1.TOOLS  \ DEBUG
NEEDS MARKER FROM DSK1.MARKER
NEEDS MALLOC FROM DSK1.MALLOC
NEEDS RND    FROM  DSK1.RANDOM
NEEDS COLOR  FROM DSK1.GRAFIX
NEEDS SPRITE FROM DSK1.DIRSPRIT
NEEDS FORK   FROM DSK1.MTASK99

: HEX#, ( addr len  --) \ can be used for longstrings (128 bytes)
        BASE @ >R  \ save radix
        HEX               \ we are converting hex numbers in the string
        BEGIN
        DUP WHILE        \ while len<>0
            2DUP DROP 4  \ get 4 digits from left end of string
            NUMBER? ABORT" Bad number"  \ convert string to number
             ,           \ compile the integer into memory
            4 /STRING    \ cut 4 digits off left side of string
        REPEAT
        2DROP
        R> BASE !  \ restore radix
;

DECIMAL
CREATE Japanese
  S" 007E087E08300000"  HEX#,
  S" 007E020202027E00"  HEX#,
  S" 0044442404043800"  HEX#,
  S" 0000600464087000"  HEX#,
  S" 0004081030501000"  HEX#,
  S" 0028282828284400"  HEX#,
  S" 0000107C107C1000"  HEX#,
  S" 003C448404041800"  HEX#,
  S" 003C000000007E00"  HEX#,
  S" 003E020214080400"  HEX#,
  S" 0004040404043800"  HEX#,
  S" 0042424242023C00"  HEX#,
  S" 007C107C100C0000"  HEX#,
  S" 007C007C007C0000"  HEX#,
  S" 007C007C04380000"  HEX#,
  S" 007C44A404380800"  HEX#,
  S" 007E020438448000"  HEX#,
  S" 0020203824202000"  HEX#,
  S" 00107C1424480000"  HEX#,
  S" 00087C0808300000"  HEX#,
  S" 00407C4040403C00"  HEX#,
  S" 00007C007C106000"  HEX#,
  S" 00287C2808301400"  HEX#,
  S" 0060600404047800"  HEX#,
  S" 0054540404381400"  HEX#,
  S" 007C04281028C400"  HEX#,
  S" 007C040404043800"  HEX#,
  S" 0000107C04043800"  HEX#,
  S" 007C101010107C00"  HEX#,
  S" 00207C2420202000"  HEX#,
  S" 00107C0438540000"  HEX#,


\ : .JAPAN  CR  159 128 DO I EMIT LOOP ;  .JAPAN
\ : .JAPAN2  CR 207 176 DO I EMIT LOOP ;  .JAPAN2

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
176 128 - CONSTANT WHITECHAR  ( changes green character to white)

: >WHITE ( greenchar -- whitechar) WHITECHAR + ;
: RNDCHAR ( -- c)  30 RND 128 +  ; \ returns green charset only
: RNDCOL   ( -- col)  32 RND ;
\ : VACANT?  ( col -- ? )  0 >VPOS VC@ BL <> ;
\ HEX
\ : ISEMPTY ( col -- col')
\         RNDCOL
\         BEGIN
\           DUP VACANT?
\          WHILE
\              PAUSE
\              1+ 1F AND
\          REPEAT ;
\ DECIMAL
: RNDLEN   21 RND 4 + ; ( max will be 20+4=24 )

: VROW++  ( -- ) VROW DUP @ 1+ 23 MIN SWAP ! ;

: FALLING ( length col row  -- )
          AT-XY
          60 RND 4 +  SWAP
          ( len ) 0
          ?DO
             PAUSE
             RNDCHAR VPUT
             VROW++
             RNDCHAR >WHITE VPUT
             DUP MS
          LOOP
          DROP
;

\ \\\\\\\\\\\\\\\\\\\\\ BACKGROUND TASKS ///////////////////
: FALLER
       BEGIN
         RNDLEN  RNDCOL 0 FALLING
       AGAIN ;

: ERASER
       BEGIN
          32 RND 0 AT-XY
          50 RND 10 +  \ loop speed on stack
          24 0
          DO
             PAUSE
             BL VPUT
             VROW++
             DUP MS    \ delay to loop speed
          LOOP
          DROP         \ DROP loop speed
          200 RND MS
       AGAIN ;

CREATE GREENS   13 , 3 , 4 , 13 , 4 , 3 , 13 , 3 ,
: ]GREEN ( n)  7 AND CELLS GREENS + ; \ circular access array

: SHIMMER  \ switches charsets to random greens, random times
      0    \ first []green index
      BEGIN
        22 16 DO
          10 MS
          I  OVER ]GREEN @ 1 COLOR
          1+  \ increment index
        LOOP
        20 MS
      AGAIN
;

: TWINKLE ( colorset -- )
        PAUSE
        DUP 15 1 COLOR
        10 MS
        16 1 COLOR   \ back to white
        10 MS
;

: TWINKLER
      BEGIN
        26 22 \ white character sets
        DO
          I TWINKLE
          300 MS
        LOOP
      AGAIN
;

\ : TEST   BEGIN   22 16 DO  I ]GREEN @ . LOOP  ?TERMINAL UNTIL ;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ SPAWN allocates USER area in Low RAM, FORKS,
\ sets the awake flag and assigns a Forth word to RUN
: SPAWN  ( xt -- )  USIZE MALLOC DUP FORK DUP WAKE  ASSIGN  ;

: SPAWN-JOBS ( --)
  ['] FALLER SPAWN
  ['] FALLER SPAWN
  ['] FALLER SPAWN
  ['] FALLER SPAWN
  ['] ERASER SPAWN
  ['] ERASER SPAWN
  ['] ERASER SPAWN
  ['] SHIMMER SPAWN
  ['] TWINKLER SPAWN
;


HEX 83D6 CONSTANT ALWAYS  \ screen timeout control
: CHARACTERS ( n -- )  8* ; \ characters to write to pattern table

DECIMAL
: RUN
    WARM
    GRAPHICS
    CLEAR
    1 SCREEN
    \ source   dest.    Quantity
    \ ------   ----    ----------
    Japanese  128 ]PDT  30 CHARACTERS VWRITE \ GREEN charset
    Japanese  176 ]PDT  30 CHARACTERS VWRITE  \ WHITE charset

    INIT-MULTI
    SPAWN-JOBS

    128 SET# 168 SET#  4 1 COLORS   ( green)
    176 SET# 228 SET# 16 1 COLORS   ( white)
    MULTI
    ALWAYS ON  \ prevent screen timeout
    BEGIN      \ the console task loops to test the break key
      PAUSE
      ?TERMINAL
    UNTIL
    SINGLE
\    8 SCREEN
\    BL SET#  [CHAR] Z SET#  2 1 COLORS
    BYE
;



  LOCK
  INCLUDE DSK1.SAVESYS
 ' RUN SAVESYS DSK5.THEMATRIX

 

 

 

THEMATRIXII.zip