Jump to content
TheBF

Camel99 Forth Information goes here

Recommended Posts

CAMEL99 Forth /TTY

 

For anyone interested here is a re-built version of CAMEL99 Forth /TTY.  This is the first time I have put this out to the public. I am not 100% certain it is a perfect mirror of what is on my floppy disk here but it should start ok.  If you get into trouble type COLD to reboot the system if it is still responding.

 

It runs over RS232/1 on a regular TI-994a with RS232 card and floppy drives.  I would be interested to hear what happens with some of the alternative disk systems out there. It "should" work with whatever DSR is installed for the device. (he said quietly,  his lip trembling slightly...)

 

Disk utilities are CAT, DIR and MORE (to see a text file)

Editors are only working for VDP and console keyboard at this time. More work for me.

 

Disclaimer: Not all of the demo programs on DSK3. work as expected because they were made for VDP terminal. Caveat Emptor

 

 

 

CAMEL99TTY.260.zip

  • Like 4

Share this post


Link to post
Share on other sites

Just curious...

 

Has anyone tried CAMEL99Forth /TTY version?

 

I am also curious how it works with TIPI or some other disk drives on TI-99 systems.

 

Share this post


Link to post
Share on other sites

Sometimes the world presents us with strange coincidences  

 

A while back I added a string comparator to the CASE statement in Forth just to see what it would take.

 

I am working on porting my SAMS editor to a VT100 terminal and guess what I need?  A way to parse escape strings and run code.

 

On the VT100 terminal when you press Page-up, Page-down or the cursor keys for example, the terminal emits a string of key-strokes.

For example PAGE-UP emits:  <ESC>[6~"

Where <esc> is HEX 1B.

 

So if you detect the escape character you then have to collect the next three characters as a string. That string needs to be compared to a table of strings to know what to do.

Now the Forthy way to do this might be to make Forth words called  [6~, [5~  etc.   This way the Forth language would just run the routine like any Forth word. It could even compile that routine into other routines.  The only trouble with that is we encounter an unknown sequence of characters Forth will Abort to interpreter.  There are some solutions to that problem but I will leave that for later.

 

Here is what I came up  with that seems to work but I suspect it will not be fast.  It revolves around code I developed to allow me to upload text files to disk with out using XMODEM.

TIMEKEY is routine that waits for a key until a specific time elapses. I need this because the length of the escape sequences is variable. You never know how many characters you are waiting for exactly.

STRAIGHT is the end user word to read data into a buffer & lenght set of input parameters and it returns the number of characters received.

READSEQ puts them all together and put the string in PAD as a counted string which can be fed to the CASE statement.  The case statement is for testing and just prints the name of the code it will run in the final application.

 

I did not count on this much trouble to build an editor for a VT100/ANSI terminal. :) 

: STRAIGHT ( addr len -- n)
      0 -ROT             \ char counter under address
      OVER >R            \ save the 1st buffer location
      1 /STRING  BOUNDS  ( -- end start)
      R>                 ( -- end start addr)
      KEY SWAP C!        \ wait for 1st key & store
      DO
         100 TIMEKEY DUP I C!
         0= IF 1+ LEAVE THEN
         1+
      LOOP ;

CREATE SEQ$  8 ALLOT

\ returns a counted string
: READSEQ  ( -- Caddr)  SEQ$ DUP 4 STRAIGHT  PAD PLACE  PAD ;

: $OF    ( -- )
   POSTPONE OVER   POSTPONE =$  POSTPONE IF POSTPONE DROP ; IMMEDIATE

: ESCAPE-HANDLER ( caddr -- )
         CASE
          " [5~" $OF  ." PGUP "       ENDOF
          " [6~" $OF  ." PGDN "       ENDOF
          " [A"  $OF  ." -LINE "      ENDOF
          " [B"  $OF  ." +LINE "      ENDOF
          " [D"  $OF  ." LEFT  "      ENDOF
          " [C"  $OF  ." RIGHT "      ENDOF
          " [Z"  $OF  ." -TAB  "      ENDOF

         ENDCASE ;

The screen shot shows this little test code running the code about. It exits with ^C . ( CHAR 03) 

HEX 1B CONSTANT [ESC]
: TESTER
       BEGIN
           KEY DUP [ESC] = 
           IF  READSEQ ESCAPE-HANDLER
           ELSE DUP EMIT
           THEN
           3 =
       UNTIL ;

 

COM1 - TI-99 TTY VT 2020-05-04 11_42_02 PM.png

Share this post


Link to post
Share on other sites
Posted (edited)

I was reading about and tried this program to generate Morse code on the TI-99.  

 

I thought some would find it interesting to see how you could do it in Forth.

I wrote this up for Rosetta Code a few years ago for a PC so here it is ported to Camel99 Forth.

In this method each letter of the Alphabet becomes a Forth program that knows how to send it's own Morse code sound.

The Transmit routine reads each character in a string and interprets them.  A rather different approach. 

\ MORSE CODE GENERATOR for Rosetta Code   Brian Fox, Feb 2016
\ Ported to Camel99 Forth May 2020

NEEDS VALUE FROM DSK1.VALUES
NEEDS SOUND FROM DSK1.SOUND
NEEDS FORGET FROM DSK1.FORGET

DECIMAL
 750 VALUE FREQ    \ 750 Hz will be the tone freq.
 200 VALUE ADIT    \ duration of one "dit"

\ Compute all durations based on ADIT
: DIT_DUR      ADIT MS ;
: DAH_DUR      ADIT 3 * MS ;
: WORDGAP      ADIT 5 * MS ;
: OFF_DUR      ADIT 2/ MS ;
: LETTERGAP    DAH_DUR ;   \ space between letters is commonly a DAH.

: TONE ( -- ) FREQ HZ 0 DB  ;

: MORSE-EMIT  ( char -- )
        DUP  BL =                      \ check for space character
        IF
             DROP WORDGAP              \ ignore char and delay
        ELSE
             PAD C!                    \ write char to buffer
             PAD 1 EVALUATE            \ evaluate 1 character string
             LETTERGAP
        THEN ;

: TRANSMIT ( ADDR LEN -- )
           CR                          \ newline,
           BOUNDS                      \ convert loop indices to address ranges
           DO
              I [email protected] DUP EMIT            \ dup and send char to console
              MORSE-EMIT               \ send the morse code
           LOOP ;

\ dit and dah define all the reset
: .   ( -- ) TONE  DIT_DUR  MUTE  OFF_DUR ;
: -   ( -- ) TONE  DAH_DUR  MUTE  OFF_DUR ;

\ define morse letters as Forth words. They transmit when executed
: A  . -  ;     : B  - . . . ;   : C  - . - . ;    : D  - . . ;
: E  . ;        : F  . . - . ;   : G  - - . ;      : H  . . . . ;
: I  . . ;      : J  . - - - ;   : K  . - . ;      : L  . - . . ;
: M  - - ;      : N  - . ;       : O  - - - ;      : P  . - - . ;
: Q  - - . - ;  : R  . - . ;     : S  . . . ;      : T  - ;
: U  . . - ;    : V  . . . - ;   : W  . - - ;      : X  - . . - ;
: Y  - . - - ;  : Z  - - . . ;

: 0  - - - - - ;     : 1  . - - - - ;
: 2  . . - - - ;     : 3  . . . - - ;
: 4  . . . . - ;     : 5  . . . . . ;
: 6  - . . . . ;     : 7  - - . . . ;
: 8  - - - . . ;     : 9  - - - - . ;

: '  - . . - . ;     : \  . - - - . ;    : !  . - . - . ;

: ?  . . - - . . ;
: ,  - - . . - - ;
: /  . . . - . - ;  ( SK means end of transmission in int'l Morse code)
: .  . - . - . - ;


 ( ~ 10 words per minute )
S" CQ CQ CQ DE VE3CFW / " TRANSMIT

Note:  I am getting different timing on Classic99 versus real iron. Hmm... ?

         This was my mistake. They both run at the same speed but... the real iron timing using the 9901 is more precise than Classic99 under windows. (to be expected)

         On the real hardware the letters are crisp and accurate every time even at morse code speeds of 20 WPM.  

         Camel99 Forth's  timer word MS, shines on real hardware.

Edited by TheBF
note added
  • Like 1

Share this post


Link to post
Share on other sites
Posted (edited)

Duplicated

Edited by TheBF
Duplicate post

Share this post


Link to post
Share on other sites

In the process of fighting with making an editor for the VT100 terminal I looked into what features I had.

I have a simple file that compiles on startup with the TTY version of Camel99 Forth that gives cursor positioning, clearing the screen as well some basic cursor movements.

I took the approach of creating a tag type language for this lexicon so the VT100 words stand out from other Forth words. Kind of HTMLish. :) 

CR .( VT100 terminal control)
DECIMAL
\ type 'n' as a two digit number in base 10, with no space
: <##>   ( n -- )
         BASE @ >R                   \ save radix
         0 <#  DECIMAL # #  #> TYPE  \ convert to 2 digits & print
         R> BASE ! ;                 \ restore radix

\ markup language for terminal control codes
: <ESC>   ( -- )   27 EMIT ;
: <ESC>[  ( -- )   <ESC> 91 EMIT  ;
: <UP>    ( n -- ) <ESC>[ <##> ." A" ;
: <DOWN>  ( n -- ) <ESC>[ <##> ." B" ;
: <RIGHT> ( n -- ) <ESC>[ <##> ." C" ;
: <BACK>  ( n -- ) <ESC>[ <##> ." D" ;
: <HOME>  ( -- )   <ESC>[ ." H"  1 1 VROW 2! ;

\ define Forth words using markup words
: PAGE    ( n -- ) <ESC>[ ." 2J" <HOME> ;
: AT-XY   ( col row --) ( uses base 0 coordinates)
          2DUP VROW 2!  \ store col,row
          <ESC>[ <##> ." ;" <##> ." f" ;

Here are some scrolling controls. I have created separate files to save space in a program that doesn't need everything.

CR .( VT100+.FTH  extended terminal control)
NEEDS <##> FROM DSK1.VT100

DECIMAL
: <RESETVT100> ( -- ) <ESC> [CHAR] c EMIT ; \ reset the terminal
: <SCROLLALL>  ( -- ) <ESC>[ ." r" ; \ Enable scrolling for entire display.

\ Enable scrolling from row {start} to row {end}.
: <SCROLLROWS> ( rstart rend-- ) SWAP <ESC>[ <##> ." ;" <##> ." r" ;
: <SCROLLDOWN> ( -- ) <ESC> [CHAR] D EMIT ; \ Scroll display down one line.
: <SCROLLUP>   ( -- ) <ESC> [CHAR] M EMIT ; \ Scroll display up one line.

\ Erasing Text
: <ERASERIGHT>     <ESC>[ ." K"  ;  \ Erase from cursor to end of line
: <ERASELEFTS>     <ESC>[ ." 1K" ;  \ Erase from Cursor to start of line
: <ERASELINE>      <ESC>[ ." 2K" ;  \ Erases the entire current line
: <ERASEDOWN>      <ESC>[ ." J"  ;  \ Erases screen from current line down
: <ERASEUP>        <ESC>[ ." 1J" ;  \ Erases screen from current line up

And here is some color control

CR .( VT100COLR.FTH Display Attribute control lexicon) \ BJF May 2020

NEEDS <##>  FROM DSK1.VT100

DECIMAL
\ colors
0 CONSTANT BLK
1 CONSTANT RED
2 CONSTANT GRN
3 CONSTANT YEL
4 CONSTANT BLU
5 CONSTANT MAG
6 CONSTANT CYN
7 CONSTANT WHT

: <ATTRIB>   ( n -- )  <ESC>[ <##> ." m" ;

\ Usage:  BLK <FG> CYN <BG>
: <FG>  ( color -- )  30 + <ATTRIB> ;   \ convert to foreground value
: <BG>  ( color -- )  40 + <ATTRIB> ;   \ convert to background value

\ attributes
: <DEFAULT>    0 <ATTRIB> ;
: <BRIGHT>     1 <ATTRIB> ;
: <DIM>        2 <ATTRIB> ;
: <UNDERSCORE> 4 <ATTRIB> ;
: <BLINK>      5 <ATTRIB> ;
: <REVERSE>    7 <ATTRIB> ;
: <HIDDEN>     8 <ATTRIB> ;

Here is some test code and a little video


: A$ S" This sentence will be displayed with different attributes." ;

\ TEST CODE
: TESTBG  CR 8 0 DO  I <BG> A$ TYPE CR  LOOP  <DEFAULT> CR ;
: TESTFG  CR 8 0 DO  I <FG> A$ TYPE CR  LOOP  <DEFAULT> CR ;
: TESTATTRIB  CR 8 0 DO I <ATTRIB> A$ TYPE CR  LOOP  <DEFAULT> CR ;

 

  • Like 3

Share this post


Link to post
Share on other sites

@TheBF You asked about testing on some of the other hardware that is out there...

 

On my 4A, no cartridge, just 32k + Tipi Sideport, and usb keyboard adapter... 

I tested loading the CAML259B program image.. 

TIPI set to 'auto map' dsk1 on program image load.

from TI BASIC:  CALL TIPI("TIPI.CAMELF99.CAML259B")

 

I see:

CAMEL99 Forth 2.59B

Loading: DSK1.START
Loading: DSK1.SYSTEM
compiling ANS Forth extensions.......

Ready
_

No cursor blink... no keyboard input... I turned off my USB keyboard adapter, just in case and tried again... same issue. 

 

I just copied all the files in the archive under DISK1.ITC onto the TIPI, they seem to be TIFILES files already. 

 

It seems to read around 3 records from DSK1.START, and then many from DSK1.SYSTEM, and then more from DSK1.START

 

 

 

  • Like 1

Share this post


Link to post
Share on other sites

Ah, follow up... 

 

Loading from an Editor/Assembler cart, works fine... blinky blinky... 

." Hello World"  Hello World ok

 

 

  • Like 1

Share this post


Link to post
Share on other sites
11 hours ago, jedimatt42 said:

Ah, follow up... 

 

Loading from an Editor/Assembler cart, works fine... blinky blinky... 

." Hello World"  Hello World ok

 

 

Thank you!

 

So that points perhaps to the way that I am doing blinky part and how it interacts with other hardware.

I explored two methods. One uses the 9901 timer the other uses the interrupt driven counter in scratch pad RAM.

I have to double back and check which method is used in that version, but I believe it is the 9901 timer which I have running continuously. 

If the other hardware is blocking the timer somehow that would stop the blinky thing. :)

 

Thanks again for the testing.

 

Share this post


Link to post
Share on other sites
13 hours ago, jedimatt42 said:

@TheBF You asked about testing on some of the other hardware that is out there...

 

On my 4A, no cartridge, just 32k + Tipi Sideport, and usb keyboard adapter... 

I tested loading the CAML259B program image.. 

TIPI set to 'auto map' dsk1 on program image load.

from TI BASIC:  CALL TIPI("TIPI.CAMELF99.CAML259B")

 

I see:

CAMEL99 Forth 2.59B

Loading: DSK1.START
Loading: DSK1.SYSTEM
compiling ANS Forth extensions.......

Ready
_

No cursor blink... no keyboard input... I turned off my USB keyboard adapter, just in case and tried again... same issue. 

 

I just copied all the files in the archive under DISK1.ITC onto the TIPI, they seem to be TIFILES files already. 

 

It seems to read around 3 records from DSK1.START, and then many from DSK1.SYSTEM, and then more from DSK1.START

 

 

 

To confirm: This version is using the interrupt driven counter at >8379 to time how fast to blink the cursor.

It looks like TIPI disables this counter. (?)

 

If I send you the version that uses the 9901 timer could I trouble you to try that one?

 

 

Share this post


Link to post
Share on other sites
8 hours ago, TheBF said:

To confirm: This version is using the interrupt driven counter at >8379 to time how fast to blink the cursor.

It looks like TIPI disables this counter. (?)

 

If I send you the version that uses the 9901 timer could I trouble you to try that one?

 

 

 

It is likely something I'm not initializing in my EA5 loader built into the TIPI DSR ROM... 

It works fine from loading from TIPI, but using the EA5 loader in the actual Editor/Assembler GROM.

 

The only interrupt'y stuff I mess with in that process is LIMI 0..  My loader is probably leaving LIMI 0.  unmasking what you need would probably protect your program from my bad-behavior... I was, under the impression that EA left interrupts off before launching into the loaded image, but I must have measured that wrong... I will likely update the DSR on TIPI to fix this, cause my intention is for CALL TIPI to be as close to EA option 5 loading as is reasonable. 

 

Share this post


Link to post
Share on other sites
3 hours ago, jedimatt42 said:

I was, under the impression that EA left interrupts off before launching into the loaded image, but I must have measured that wrong...

 

On page 164 of the E/A Manual it says

 

The instruction, “LIMI 0”, disables all interrupts and is the normal state of the computer.

 

And, in fact, any program started by the E/A loader will have interrupts disabled unless the loaded program enables them.

 

If interrupts are enabled, the console interrupt routine increments the screen timer (>83D6, interrupt workspace R11) by 2 each interrupt. The screen timer is reset by the console’s KSCAN at every keystroke if the loaded program uses KSCAN for keyboard input. I cannot imagine how TIPI would be affecting the screen timer.

 

...lee

  • Like 1
  • Thanks 1

Share this post


Link to post
Share on other sites
6 hours ago, Lee Stewart said:

 

On page 164 of the E/A Manual it says

 

The instruction, “LIMI 0”, disables all interrupts and is the normal state of the computer.

 

And, in fact, any program started by the E/A loader will have interrupts disabled unless the loaded program enables them.

 

If interrupts are enabled, the console interrupt routine increments the screen timer (>83D6, interrupt workspace R11) by 2 each interrupt. The screen timer is reset by the console’s KSCAN at every keystroke if the loaded program uses KSCAN for keyboard input. I cannot imagine how TIPI would be affecting the screen timer.

 

...lee

That manual is a real gold mine. 

 

In the release that JediMatt tested I was not reading the screen timer but rather the random number seed  at >8379,  which continues spinning on one byte with the E/A cartridge.

Could it be that TI BASIC changes that location or stops incrementing it when it starts?  I will have to check that here. 

Nevertheless it was a test version to see if that would work better than the 9901 timer. I should think that the timer is a better strategy for general use.

 

Share this post


Link to post
Share on other sites
9 hours ago, jedimatt42 said:

 

It is likely something I'm not initializing in my EA5 loader built into the TIPI DSR ROM... 

It works fine from loading from TIPI, but using the EA5 loader in the actual Editor/Assembler GROM.

 

The only interrupt'y stuff I mess with in that process is LIMI 0..  My loader is probably leaving LIMI 0.  unmasking what you need would probably protect your program from my bad-behavior... I was, under the impression that EA left interrupts off before launching into the loaded image, but I must have measured that wrong... I will likely update the DSR on TIPI to fix this, cause my intention is for CALL TIPI to be as close to EA option 5 loading as is reasonable. 

 

I think Lee has clarified "normal" from the sacred text, so please don't change your code on my account.

I am the wild card.  I have re-built and reverted back to using the 9901 timer which is how it was since Version 2 of this project began.  That gave some problems in Classic99 at one point but it has long since been fixed. 

 

My motivation for these step-wise changes has been exploring removing bytes from the kernel to have more space for user programs. I think I am at the end of that exercise.

 

If it ain't broke etc... :)

 

 

  • Thanks 1

Share this post


Link to post
Share on other sites
4 hours ago, TheBF said:

That manual is a real gold mine. 

 

In the release that JediMatt tested I was not reading the screen timer but rather the random number seed  at >8379,  which continues spinning on one byte with the E/A cartridge.

Could it be that TI BASIC changes that location or stops incrementing it when it starts?  I will have to check that here. 

Nevertheless it was a test version to see if that would work better than the 9901 timer. I should think that the timer is a better strategy for general use.

<pedantic mode>

>8379 is the VDP interrupt timer (VIT) byte. It is not, technically, the random number seed (RNS) for the TI-99/4A except that it is used by TI Basic’s RANDOMIZE to set an unpredictable RNS.

 

The random number seed (RNS) is >83C0 (interrupt workspace R0). I haven’t tracked down where this happens, but, while sitting on the opening menu, the TI-99/4A spins RNS until you make a selection.  Upon selecting “1 FOR TI BASIC”, TI Basic always sets RNS to the same number, viz., >3567. The E/A cartridge, on the other hand, does not, but rather, leaves it where it was when you selected “2 FOR EDITOR/ASSEMBLER”, which means E/A starts up with a “random” RNS.

 

The GPL RAND routine (used by TI Basic’s RND) uses and updates RNS, but only returns a byte value in >8378 as its result. As stated above, TI Basic’s RANDOMIZE, indeed, does use the current byte value in >8379 (VIT) to re-seed RNS, but it only modifies the LSB at >83C1.

</pedantic mode>

 

...lee

Share this post


Link to post
Share on other sites

Thank you for the clarification.

I always appreciate your details.

  • Like 1

Share this post


Link to post
Share on other sites
20 hours ago, jedimatt42 said:

The only interrupt'y stuff I mess with in that process is LIMI 0..  My loader is probably leaving LIMI 0.  unmasking what you need would probably protect your program from my bad-behavior... I was, under the impression that EA left interrupts off before launching into the loaded image, but I must have measured that wrong... I will likely update the DSR on TIPI to fix this, cause my intention is for CALL TIPI to be as close to EA option 5 loading as is reasonable. 

Yeah, don't launch programs with interrupts enabled - a lot of software will break. :)

 

  • Thanks 1

Share this post


Link to post
Share on other sites
35 minutes ago, Tursi said:

Yeah, don't launch programs with interrupts enabled - a lot of software will break. :)

 

Noted. Thanks!

Share this post


Link to post
Share on other sites
14 hours ago, Tursi said:

Yeah, don't launch programs with interrupts enabled - a lot of software will break. :)

 

To be sure I was abiding by this I checked. Camel99 enters it's first code to create the virtual machine. 

(set workspace, init 3 registers, write some code into scratchpad  and init 1 memory location)

Interrupts are off by default from E/A 5 as mentioned.

I don't enable interrupts until I start Forth and load a value into the 9901 timer. When that code exits it enables interrupts.

So more by ignorance than design, back when I made this thing I did follow this advice. :) 

Share this post


Link to post
Share on other sites

VT100 driver Change

While working on porting an editor to TTY control I did a re-read of the control code specs and discovered that the terminal assumes cursor home is coordinates (1,1).

Standard Forth AT-XY (and GOTOXY in TI-Forth, FbForth and TurboForth)  assumes home is (0,0).

I have modified a couple of words in my code to compensate.  This has made my porting of the editor code way easier. :) 

The word AT-XY is modified below:

CR .( VT100 terminal control, [0,0] Home coordinates  May 2020 )
DECIMAL
\ type 'n' as a two digit number in base 10, with no space
: <##>   ( n -- )
         BASE @ >R                   \ save radix
         0 <#  DECIMAL # #  #> TYPE  \ convert to 2 digits & print
         R> BASE ! ;                 \ restore radix

\ markup language for terminal control codes
: <ESC>   ( -- )   27 EMIT ;
: <ESC>[  ( -- )   <ESC> 91 EMIT  ;
: <UP>    ( n -- ) <ESC>[ <##> ." A" ;
: <DOWN>  ( n -- ) <ESC>[ <##> ." B" ;
: <RIGHT> ( n -- ) <ESC>[ <##> ." C" ;
: <BACK>  ( n -- ) <ESC>[ <##> ." D" ;
: <HOME>  ( -- )   <ESC>[ ." H"   0 0 VROW 2! ;

\ define Forth words using markup words
: PAGE    ( n -- ) <ESC>[ ." 2J"  <HOME> ;
: AT-XY   ( col row --)
          2DUP VROW 2!  \ store col,row
          <ESC>[ 1+ <##> ." ;" 1+ <##> ." f" ;

And the word <SCROLLROWS> below has been correct to reflect 0,0 screen home.  <SCROLLROWS> is pretty cool. It lets you set a section of the screen that scrolls between rstart row and rend row.

CR .( VT100+.FTH  extended terminal control)

NEEDS <##> FROM DSK1.VT100

DECIMAL
\ reset the terminal, clear screen & buffer
: <RESETVT100> ( -- ) <ESC> [CHAR] c EMIT ;

\ More VT100 terminal controls
: <SCROLLALL>  ( -- ) <ESC>[ ." r" ; \ Enable scrolling for entire display.

\ Enable scrolling from row {start} to row {end}. [0,0] IS HOME !!
: <SCROLLROWS> ( rstart rend-- ) SWAP <ESC>[ 1+ <##> ." ;" 1+ <##> ." r" ;
: <SCROLLDOWN> ( -- ) <ESC> [CHAR] D EMIT ; \ Scroll display down one line.
: <SCROLLUP>   ( -- ) <ESC> [CHAR] M EMIT ; \ Scroll display up one line.

\ Erasing Text
: <ERASERIGHT>     <ESC>[ ." K"  ;  \ Erase from cursor to end of line
: <ERASELEFT>      <ESC>[ ." 1K" ;  \ Erase from Cursor to start of line
: <ERASELINE>      <ESC>[ ." 2K" ;  \ Erases the entire current line
: <ERASEDOWN>      <ESC>[ ." J"  ;  \ Erases screen from current line down
: <ERASEUP>        <ESC>[ ." 1J" ;  \ Erases screen from current line up

 

  • Like 1

Share this post


Link to post
Share on other sites

Who needs string comparison case statements?

 

In the course of porting an editor to TTY over RS232 I bumped into the challenge of escape key sequences.  One way to do it is to read the sequences into strings and then compare the strings to other strings to determine which control sequences was sent from the terminal. However...

It occurred to me that a faster way to do it would be to hash the characters sequence into a unique number and then use a regular integer case statement to do the correct action.

The sequences are short so the overhead to hash the string is small.

 

Here is what I came up with to test the concept.  Since the sequences are variable I use TKEY to wait for each character. TKEY will read a key or return zero if  the key does not arrive in time.

Then for the 2nd, 3rd and 4th character I multiply the ascii value by a different value. Actually I just do 3 different shifts.  I tried just summing the ascii values but I could not differentiate the keys F9..F12 from the F1 to F4 keys without doing the multiply operations.  

 

The longest string is 4 chars but I got cleaner read by adding a 5th TKEY.  When a key is held down this reader would get out of sync and generate a single ascii character which would go into the text of the editor if I left it there. The extra TKEY cleaned that up.

 

The first KEYHANDLER reads normal control keys with single value output. If it detects the ESC key it calls the ESCHANDLER to deal with the control sequence. 

The short video demonstrates this test code.

 

\ Esc sequence decoder using hashing

NEEDS CASE FROM DSK1.CASE

MARKER REMOVE 

HEX 1B CONSTANT [ESC]

: TKEY ( wait-time -- 0 | c )  \ waits for a key -or- until counter hits zero
      BEGIN 1- DUP
      WHILE
        CKEY? ?DUP
        IF  NIP   EXIT THEN
      REPEAT ;

DECIMAL
: HASHKEY ( -- n)
          75 TKEY
          75 TKEY 2*
          75 TKEY 4*
          75 TKEY 8*
          75 TKEY            \ dummy read
          +  +  +  + ;       \ 5 timed reads & sum

HEX
: ESCHANDLER ( -- )
        HASHKEY
        CASE                                               \ TESTED
          02B5 OF  ." HOME "     ENDOF  \ PC Home
          02B7 OF  ." INSERT "   ENDOF  \ PC Insert
          02BB OF  ." END "      ENDOF  \ PC End
          02BD OF  ." PGUP  "    ENDOF  \ PC Page up
          02BF OF  ." PGDN  "    ENDOF  \ PC Page down
          00DD OF  ." UPARROW "  ENDOF  \ PC up arrow
          00DF OF  ." DNARROW "  ENDOF  \ PC down arrow
          00E1 OF  ." RIGHT "    ENDOF  \ PC right arrow
          00E3 OF  ." LEFT "     ENDOF  \ PC left arrow
          010F OF  ." -TAB "     ENDOF  \ PC shift TAB
        \ PC function keys
          0571 OF  ." FCTN1 "    ENDOF
          0575 OF  ." FCTN2 "    ENDOF
          0579 OF  ." FCTN3 "    ENDOF
          057D OF  ." FCTN4 "    ENDOF
          0581 OF  ." FCTN5 "    ENDOF
          0589 OF  ." FCTN6 "    ENDOF
          058D OF  ." FCTN7 "    ENDOF
          0591 OF  ." FCTN8 "    ENDOF
          056F OF  ." FCTN9 "    ENDOF
          0573 OF  ." FCTN10 "   ENDOF
          057B OF  ." FCTN11 "   ENDOF
          057F OF  ." FCTN12 "   ENDOF

         ENDCASE ;


: KEYHANDLER ( char -- ) \ VT100 TERMINAL key codes
    CASE
     [ESC]    OF  ESCHANDLER  ENDOF  \ if we get ESC key
     [CHAR] A OF  ." A "      ENDOF
     [CHAR] B OF  ." B "      ENDOF
     [CHAR] C OF  ." C "      ENDOF
            9 OF  ." TAB "    ENDOF
            3 OF  CR QUIT     ENDOF  \ ^C
                 7 EMIT       \  key not found, ring the bell
    ENDCASE ;

HEX
: TEST    KEY  HASHKEY . ;

: TESTHASH   BEGIN   KEY  KEYHANDLER   AGAIN ;

 

 

  • Like 1

Share this post


Link to post
Share on other sites

I am still having trouble managing the escape sequences fired at the editor when using the PC extended keys. (arrows, Pgup etc.) 

I have decided to make the editor for TTY interface emulate VI. This way the commands and text editing handlers are separated to a greater degree.

Interestingly I read that some version so VI don't work right with the extended keys either so I don't feel quite so inadequate.

 

The good news is that I have most of the editor code in good shape so I just have to make the command acceptance part.

More to come.

  • Like 1

Share this post


Link to post
Share on other sites

A Little Preview of VI99

 

It's about 470 lines of Forth at the moment and sucks up 5K of memory. Not very Forthy but I have to make it work first.

I bought a SAMS card specifically because I wanted to handle larger text files.  I think I will need to create a SAMS CODE segment to allow switching the editor in/out of the system to make a better IDE.

However even as is there is 8K of Forth memory left for project code plus 4K of HEAP when this big editor is loaded. With Forth running in super cart I will have a whopping 16K of project space. :) 

 

I am still experimenting with how best way to work with escape characters but it's now starting to feel useable even at 9600 bps, my default speed on Camel99 Forth /TTY.

 

 

 

  • Like 2

Share this post


Link to post
Share on other sites

So now that I have created a monster sized editorI am struggling with how to shoe-horn it all into a functional system running on a real TI-99 that leaves more room for building applications.

I have a solution for DATA in the SAMS card but up to now I have not focused on compiling into SAMS memory.

I realized today that some of the work I did earlier of compiling tools into LOW RAM and then removing the tools from the dictionary gives me some insights.

 

I took the time to re-organize that code so it is more generally useful.  The words  TRANSIENT, PERMANENT and ERADICATE give some nice new functionality.

A typical use would be when you need the Assembler but don't want the Assembler to take up 2.5K of space after it is used to compile your program.

Here is how the new words let you load the assembler at compile time and then "ERADICATE" it when you are done with it.  The only penalty being that you must compile the assembler at least once.

In the example below the assembler is put into Low RAM but TRANSIENT takes any address as an argument.  However you must put it somewhere that will not be overwritten! 🙂

\ test transient assembler
NEEDS TRANSIENT  FROM DSK1.TRANSIENT

1E00 MALLOC TRANSIENT  ( transient code will go into the HEAP)

INCLUDE DSK1.ASM9900   ( compile the assembler as normal)


PERMANENT              ( Now compile to normal Forth dictionary)
CODE @ ( addr -- n)
     *TOS TOS MOV,
      NEXT,
ENDCODE

ERADICATE              ( assembler is gone, but '@' remains)

Here are the definitions that do the job. The concept is generally transportable to the other TI-99 Forth systems but the devil is in the details.

CR .( Compile Tools in LOW RAM)
NEEDS MALLOC FROM DSK1.MALLOC
HEX
VARIABLE SAVEDP
VARIABLE KEEP

CR .( Set up low ram compiling ...)
\ *INSIGHT*
\ SAVEDP holds the LINK field of the 1st new word we will create in HI RAM
: TRANSIENT ( addr -- )
           LATEST @ KEEP !
           HERE SAVEDP !     \ save the dictionary pointer.
           DP ! ;            \ Point DP to transient memory

CR .( Restore high ram compiling ...)
: PERMANENT ( -- )
           HERE H !          \ give back what we didn't use to the HEAP
           SAVEDP @ DP ! ;   \ restore DP back to original address

: ERADICATE ( -- )
          KEEP @ SAVEDP @ !  \ relink the dictionary
          2050 H ! ;         \ init-the heap. (INCLUDE buffer is at >2000)

 

  • Like 2

Share this post


Link to post
Share on other sites

Still struggling with how best to implement a vi style editor over RS232.  I moved Camel99 TTY Forth up to 19200 bps and it makes for better screen refresh time.

The thing I am struggling with the most is my desire to use the PC arrow, pgup, pgdn keys etc. which are little strings of characters rather than a single character.

I works as is but I cannot auto repeat with those escape key codes with the current esc key interpreter.  

 

I may have to relent and simply revert back to the single key codes used by the original vi specs.

 

Something interesting I have measured using the floppy drives points to issue of using big files with floppy drives.

The 480ish line source code for the editor takes 55 seconds to compile. (if all the library files are already compiled).

It takes 45 seconds to load the source code into the editor which means Forth can compile almost as fast as it can read the data from the file. :) 

 

The spoiler has the source code for anybody who might want to see it.  This version has successfully modified itself on a floppy disk. That's some progress.

 

Spoiler
\ VI99  vi style editor for Camel99 Forth /TTY    May 30, 2020 Brian Fox
\ Uses full PC keyboard with escape sequences
NEEDS DUMP      FROM DSK1.TOOLS
NEEDS FORGET    FROM DSK1.FORGET
NEEDS CASE      FROM DSK1.CASE
NEEDS READ-LINE FROM DSK1.ANSFILES
NEEDS PAGED     FROM DSK1.SAMSFTH
NEEDS -TRAILING FROM DSK1.TRAILING
NEEDS .R        FROM DSK1.UDOTR
NEEDS <ESC>     FROM DSK1.VT100
NEEDS <SCROLLALL> FROM DSK1.VT100+
NEEDS COMPARE   FROM DSK1.COMPARE

MARKER EDITOR
.( .)
HERE
CR .( V199 Multi-file Editor V0.9 BFox 2020) CR
HEX 1000 CONSTANT 4K
\ cursor characters
DECIMAL
\ screen management & record constants
    C/[email protected] CONSTANT WIDTH   \ screen width. Detects 40/80 columns
      80 CONSTANT #80     \ length of file records
      16 CONSTANT EL/SCR  \ editor lines per screen
     128 CONSTANT RECSIZE
     500 CONSTANT MAXLINES
WIDTH 1- CONSTANT RMARGIN
         VARIABLE INSERTING

\ utility words
: GETXY   ( -- COL ROW)  VROW [email protected] ;
: BLANK   ( adr len -- ) BL FILL ;
: BETWEEN ( n lo hi -- ? ) 1+ WITHIN ;
: CLIP    ( n n1 n2 -- n1..n2) ROT MIN MAX ;
: BELL    ( -- ) 7 EMIT ;  \ TTY "ring bell" control

\ VT100 simple windowing controls
: EDWINDOW        2 18 <SCROLLROWS>  0  2 AT-XY ;
: FORTHWINDOW    19 23 <SCROLLROWS>  0 19 AT-XY ;
.( .)
HEX
\ busy spinner ...
VARIABLE SPIN#
CREATE SCHARS   CHAR | C, CHAR / C, CHAR - C, CHAR \ C,
: SPINCHAR ( -- char ) SPIN# @ 1+ 3 AND DUP SPIN# ! SCHARS + [email protected] ;
: SPINNER  ( -- )      SPINCHAR CEMIT  1 <BACK> ;
.( .)
\ SEG variable indexes into FILENAMES and editor variables
DECIMAL
CREATE FILENAMES  \ counted strings 15 bytes + COUNT BYTE
     S" deadbeefdeadbee" S, \ SEG=0 NOT USED
     S" DSK1.UNTITLED  " S, \ 1
     S" DSK1.UNTITLED  " S, \ 2
     S" DSK1.UNTITLED  " S, \ 3
     S" DSK1.UNTITLED  " S, \ 4
     S" DSK1.UNTITLED  " S, \ 5
     S" DSK1.UNTITLED  " S, \ 6
     S" DSK1.UNTITLED  " S, \ 7
     S" DSK1.UNTITLED  " S, \ 8
     S" DSK1.UNTITLED  " S, \ 9
     S" DSK1.UNTITLED  " S, \ 10

: FILENAME ( -- caddr) SEG @ 16 *  FILENAMES + ;
\ EVARS can hold 10 different values. One for each SAMS segment
: EVAR: ( -- addr ) \ nil   1   2   3   4   5   6   7   8   9  10
        CREATE          0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
        DOES>  SEG @ CELLS +  ( -- addr) ;

EVAR: LASTLINE
EVAR: TOPLINE
EVAR: EROW
EVAR: ECOL

\ compute address of 128 byte record in any SAMS segment
: REC#    ( -- n ) EROW @ TOPLINE @ + ; \ the record  we are editing
: ]RECORD       ( n -- SAMSaddr) RECSIZE *  PAGED  ;
: [REC#]RECORD  ( -- SAMSaddr)  REC# ]RECORD ;

\ FILE & SAMS memory card interface
: ?R/WERR  ( n -- ) ?DUP IF . TRUE ABORT" R/W error" THEN ;
.( .)
DECIMAL
: PURGE-SEGMENT ( -- ) \ erases 4K pages at once
      16 0
      DO
         I 4K * PAGED ( -- SAMS_ADDR)
         4K BLANK
         SPINNER
      LOOP ;

: FILE2SAMS ( addr len -- )
     2DUP FILENAME PLACE
     DV80 R/O OPEN-FILE ?FILERR >R
     TOPLINE OFF
     LASTLINE OFF
     BEGIN
       PAD DUP 80 [email protected] READ-LINE ?R/WERR ( -- pad len ?)
     WHILE
       LASTLINE @ ]RECORD ( pad len record) SWAP CMOVE
       SPINNER
       LASTLINE 1+!
     REPEAT
     R> CLOSE-FILE ?FILERR ;
.( .)
\ save SAMS memory, remove trailing zeros
VARIABLE SH   \ save handle var is simpler inside DO/LOOP
: SAMS2FILE ( addr len -- )
     DV80 W/O OPEN-FILE ?FILERR SH !
     LASTLINE @ 1+  0
     ?DO
       I ]RECORD #80 -TRAILING 1 MAX  SH @ WRITE-LINE ?R/WERR
       SPINNER
     LOOP
     SH @ CLOSE-FILE ?FILERR ;
.( .)
\ SCREEN formatting
: .FILENAME  ( -- )
   0 0 AT-XY <ERASELINE> ." #"  SEG @ 2 .R ." | "  FILENAME COUNT TYPE ;

: .LINE#     ( -- )
    64 0 AT-XY ." Line "  REC# 3 .R  ." /" LASTLINE @ 3 .R ;

: RULE$1  ( -- addr len) S" 0----+----1----+----2----+----3----+----" ;
: RULE$2  ( -- addr len) S" 4----+----5----+----6----+----7----+----" ;
: .TOPBAR  ( -- ) 0  1 AT-XY RULE$1 TYPE  RULE$2 TYPE ;

: 10DBL    ( -- ) ." ==========" ;
: .40DBL   10DBL  10DBL 10DBL 10DBL  ;
: .BOTBAR  ( -- ) 0 18 AT-XY .40DBL .40DBL ;
: .HEADER  ( -- ) .FILENAME  38 0 AT-XY ." VI99"  .LINE# .TOPBAR ;
: DRAW.SCR ( scr# -- ) PAGE  .HEADER  .BOTBAR ;

DECIMAL
: LEN  ( recaddr -- addr len) WIDTH -TRAILING ;
: LIST ( -- )
     0 2 AT-XY
     TOPLINE @ DUP EL/SCR + SWAP
     DO
       I ]RECORD LEN <ERASELINE> TYPE CR
     LOOP ;
.( .)
DECIMAL
: PROMPT: ( -- ) 1 19 AT-XY <ERASELINE> ;
: STATUS: ( -- ) 1 23 AT-XY <ERASELINE> ;

: ?ERR    ( ERR# $addr len -- )
          ROT ?DUP IF  PROMPT: TYPE .  KEY DROP ABORT THEN ;
\ cursor movement
DECIMAL
: HOMECURS  ( -- )   EROW OFF   ECOL OFF ;
: COL&ROW   ( -- ecol erow) ECOL @  EROW @ 2+ ; \ Editor's X,Y on screen
: PUTCURS   ( -- ) COL&ROW  AT-XY  ;
: EDLINE    ( -- addr len ) [REC#]RECORD  LEN ;
: 'CURS     ( -- n ) ECOL @ ;          \ cursor pos. in record
: 'CHAR     ( --  adr ) [REC#]RECORD 'CURS + ; \ address in disk block
: !CHAR     ( n -- )   'CHAR C!    ;

: RIGHTSIDE ( -- addr len) [REC#]RECORD #80  'CURS  /STRING ;
\ : LEFTSIDE  ( -- addr len) EDLINE 'CURS - ;
: RELINE    ( -- ) <ERASERIGHT>  RIGHTSIDE -TRAILING TYPE  PUTCURS ;
: REDRAW    ( -- ) .LINE# LIST ;
.( .)
\ decrement ECOL EROW, range protected
: |MARGINS|  ( n -- n')  0  RMARGIN CLIP ;
: |ROWS| ( n -- n')  0  15 CLIP ;
: COL+!  ( n -- ) ECOL TUCK @ + |MARGINS| SWAP ! ;
: ROW+!  ( n -- ) EROW TUCK @ + |ROWS| SWAP ! ;

: LEFT  ( -- ) -1 COL+! ;
: RIGHT ( -- )  1 COL+! ;

: TOPLINE+!  ( n -- ) TOPLINE @ +   0 MAXLINES 15 - CLIP   TOPLINE ! ;
: LASTLINE!  ( -- )  LASTLINE @  REC# MAX  LASTLINE ! ;

\ end allows escaping from a routine in an IF statement
: END      ( -- ) S" EXIT THEN " EVALUATE ;  IMMEDIATE

DECIMAL
: AT-EOF?    ( -- ?) REC# LASTLINE @ = ;
: MEMFULL? ( -- ) LASTLINE @ MAXLINES = ;

: .MEMFULL ( -- ) PROMPT: ." Mem full"  BELL  1500 MS  REDRAW ;

: MARK-EOF ( -- ) S" <End of File>" LASTLINE @ 1+ ]RECORD 13 + SWAP MOVE ;

: ADD2END  ( -- )
        MEMFULL? IF .MEMFULL  END
        LASTLINE 1+!
        LASTLINE @ ]RECORD WIDTH BLANK
        MARK-EOF  ;

: ?ADD2END ( -- ) AT-EOF? IF ADD2END LIST THEN   ;

: MOVEDN ( -- )
        MEMFULL? IF .MEMFULL  END
        EROW @ 15 =
        IF   1 TOPLINE+!  1 ROW+!   LIST
        ELSE 1 ROW+!
        THEN ?ADD2END  .LINE# ;

: MOVEUP ( -- )
     REC# 0= IF  BELL END   \ top of file, get out
     EROW @ 0=
     IF  -1 TOPLINE+!
         LIST
     ELSE
         -1 ROW+!
     THEN .LINE# ;

: -TAB  ( -- ) -8 COL+!  ;
: +TAB  ( -- )  8 COL+!  ;

: TOSTART ( -- ) ECOL OFF  ;
: TOEND   ( -- ) EDLINE NIP 1+  |MARGINS| ECOL ! ;

.( .)
\ page movement
: PGUP  ( -- )
     TOPLINE @ 0=
     IF HOMECURS
     ELSE -16 TOPLINE+!
     THEN LIST .LINE# PUTCURS ;

: PGDN  ( -- )
     REC# EL/SCR +   LASTLINE @ >
     IF  BELL  END
     16 TOPLINE+!
     LIST .LINE# PUTCURS  ;

\ EDITOR functions
DECIMAL
.( .)
: WRITECHAR ( c -- ) DUP !CHAR  CEMIT RIGHT ;
: MOVELEFT  ( addr len -- )  'CHAR SWAP 1+ MOVE ;
: MOVERIGHT ( addr len -- )  'CHAR 1+ SWAP 1- MOVE ;

: PULL-LEFT  ( -- ) RIGHTSIDE 1 /STRING MOVELEFT     ;
: PUSHRIGHT ( -- ) RIGHTSIDE PAD PLACE PAD COUNT MOVERIGHT  BL !CHAR  ;
.( .)
DECIMAL
: .FORTH   ." Camel99 Forth" CR ABORT ;
: >FORTH      FORTHWINDOW  <ERASEDOWN> .FORTH  ;
: FULLSCREEN  <RESETVT100> PROMPT: .FORTH ;

\ VDP clipboard is a stack of lines in VDP RAM
HEX 1000 CONSTANT CLIPBASE     \ start of VDP RAM clipboard
: VDPHEAP   ( -- vaddr) VP @ ;
: VMALLOC   ( n -- vaddr ) VP +! VDPHEAP ;
: VFREE     ( -- ) VDPHEAP DUP #80 - CLIPBASE MAX VP ! ;

DECIMAL
\ clipboard management
: LINE2CLIP ( -- )  [REC#]RECORD  #80 VMALLOC  #80 VWRITE ;
: CLIP2LINE ( -- )  VDPHEAP [REC#]RECORD #80 VREAD  VFREE ;

\ Need to double buffer record moves for page to page transfers
: DEL-LINE  ( -- )
     AT-EOF?
     IF
        [REC#]RECORD WIDTH BLANK
        MOVEUP
     ELSE
         LASTLINE @ 1+  REC#
        ?DO
           H @  I 1+ ]RECORD OVER #80 CMOVE
          ( heap)  I ]RECORD #80 CMOVE
           SPINNER
        LOOP
        LASTLINE @ 1+ ]RECORD #80 BLANK
        LASTLINE DUP @ 1-  0 MAX SWAP !
        MARK-EOF
        REDRAW
     THEN ;

: CUT    ( -- )
      VDPHEAP CLIPBASE < IF BELL END
      LINE2CLIP  DEL-LINE ;

: BACKSPACE ( -- )
      ECOL @
      IF  LEFT  BL !CHAR PULL-LEFT
      ELSE DEL-LINE ( ?? TOEND)
      THEN  ;

: DELETE    ( -- )
      ECOL @ 0=            \ cursor at col 0
      EDLINE NIP 0=  AND   \ AND line length = 0
      IF  DEL-LINE
      ELSE PULL-LEFT        \ just delete a character
      THEN ;

: COPY-LINE ( -- ) VDPHEAP CLIPBASE < IF BELL END   LINE2CLIP ;

DECIMAL
: OPEN-LINE ( -- )
      REC# LASTLINE @
      ?DO
          H @  ( -- buffer )
          I    ]RECORD OVER #80 CMOVE
          I 1+ ]RECORD #80 CMOVE
          SPINNER
     -1 +LOOP ;

: INSERT-LINE  ( -- )
      ADD2END
      OPEN-LINE
     [REC#]RECORD #80 BLANK ;

: PASTE   ( -- )
      CLIPBASE VDPHEAP >= IF BELL END
      OPEN-LINE  CLIP2LINE  REDRAW ;

: ENTER   ( -- )
      MEMFULL? IF .MEMFULL  END
      RIGHTSIDE PAD PLACE   RIGHTSIDE BLANK
      MOVEDN INSERT-LINE
      PAD COUNT -TRAILING  [REC#]RECORD SWAP MOVE
      ECOL OFF
      MARK-EOF  LIST ;

: +FILE ( -- )  SEG @ + 1 10 CLIP SEG !  .HEADER  LIST ;
 .( ..)
\ waits for a key -or- until counter hits zero
: TKEY ( wait-time -- 0 | c )
      BEGIN 1- DUP
      WHILE
        CKEY? ?DUP
        IF  NIP   EXIT THEN
      REPEAT ;

: .MODE ( -- )
        STATUS: INSERTING @
        IF    ." -- INSERT --"
        ELSE  ." -- REPLACE --"  THEN ;

: .COMMAND  ( -- ) STATUS: ." -- COMMAND -- " ;

HEX
CREATE CMD$   8 ALLOT  \ command input buffer is counted string

: TACCEPT ( addr len  -- n)  \ timed accept
           0  -ROT
           BOUNDS
           KEY OVER C!          \ wait for 1st char
           1+                   \ bump loop start address
           DO
              100 TKEY ?DUP     \ next chars use TKEY
              IF I C! 1+
              ELSE LEAVE
              THEN
           LOOP
           1+ ;          \ count the 1st character

: GETCMD  ( -- $) CMD$  DUP 1+ 5 TACCEPT OVER C! ;
: /CHAR  ( $ -- $') COUNT 1 /STRING H @ PLACE H @ ; \ cut 1st char

\ CASE extension for stack string inputs
: =$    ( $1 $1 -- flag)  DUP [email protected] 1+ S= 0= ;
: (")   ( -- ) R> DUP COUNT + ALIGNED >R ;

\ compile a counted string literal into a definition
: "     ( -- ) [CHAR] " PARSE   POSTPONE (")  S,  ; IMMEDIATE

: $OF    ( -- )
   POSTPONE OVER   POSTPONE =$  POSTPONE IF POSTPONE DROP ; IMMEDIATE

HEX 1B CONSTANT [ESC]
: CTRL    ( <char>) BL PARSE-WORD DROP [email protected] 1F AND ;
: [CTRL]  ( -- ) ?COMP CTRL  POSTPONE LITERAL ; IMMEDIATE

: CURSCTRLS  ( $ -- )
         CASE
            " [1~"  $OF  TOSTART    ( Home)        ENDOF
            " [A"   $OF  MOVEUP     ( up arrow)    ENDOF
            " [B"   $OF  MOVEDN     ( dn arrow)    ENDOF
            " [D"   $OF  LEFT       ( Left arrow)  ENDOF
            " [C"   $OF  RIGHT      ( right arrow) ENDOF
            " [4~"  $OF  TOEND      ( End)         ENDOF
            " [5~"  $OF  PGUP                      ENDOF
            " [6~"  $OF  PGDN                      ENDOF
            " [23~" $OF -1 +FILE    ( F11)         ENDOF
            " [24~" $OF  1 +FILE    ( F12)         ENDOF
         ENDCASE
;

: CLRKEYS  ( -- )  BEGIN 100 TKEY 0= UNTIL ;

HEX
: EDITLINE  ( -- ) \ *Uses TI-99 keys E,S,D,X for cursor control
    .MODE
    BEGIN
      PUTCURS RELINE
      KEY DUP BL [CHAR] ~ BETWEEN
      IF
           INSERTING @ IF PUSHRIGHT   THEN WRITECHAR
      ELSE
           CASE
           [ESC]    OF  .COMMAND EXIT  ENDOF
                 8  OF  BACKSPACE      ENDOF  \ backspace
                7F  OF  DELETE         ENDOF  \ PC Delete
          [CTRL] M  OF  ENTER          ENDOF  \ ENTER
          [CTRL] C  OF  COPY-LINE      ENDOF  \ ^C copy to clipboard
          [CTRL] V  OF  PASTE          ENDOF  \ ^V Paste clip-stack
          [CTRL] Y  OF  CUT            ENDOF  \ ^Y Cut  to clip-stack
          [CTRL] S  OF  LEFT           ENDOF  \ Cursor left
          [CTRL] D  OF  RIGHT          ENDOF  \ Cursor right
          [CTRL] E  OF  MOVEUP         ENDOF  \ Cursor up
          [CTRL] X  OF  MOVEDN         ENDOF  \ Cursor down
          [CTRL] N  OF  INSERT-LINE    ENDOF  \ insert new blank line
                        BELL                  \ key not found
          ENDCASE
       THEN
      AGAIN ;

DECIMAL
: VIMODE ( -- )
      .COMMAND
      BEGIN
         PUTCURS GETCMD DUP 1+ [email protected]
         [ESC] =
         IF
            /CHAR  CURSCTRLS

         ELSE \ it's a single key control
           CMD$
           CASE
              " H"   $OF  EROW OFF                         ENDOF
              " i"   $OF  EDITLINE                         ENDOF
              " I"   $OF  TOSTART  EDITLINE                ENDOF
              " R"   $OF  INSERTING OFF  EDITLINE          ENDOF
              " a"   $OF  RIGHT    EDITLINE                ENDOF
              " A"   $OF  TOEND    EDITLINE                ENDOF
              " L"   $OF  15 EROW !                        ENDOF
              " o"   $OF  MOVEDN INSERT-LINE EDITLINE      ENDOF
              " O"   $OF         INSERT-LINE EDITLINE      ENDOF
              " Z"   $OF  FULLSCREEN                       ENDOF
              " :"   $OF  >FORTH ." : "                    ENDOF
                          BELL  ( not found)
           ENDCASE
         THEN
      AGAIN ;
.( .)
DECIMAL
: ?PATH ( addr len -- addr len)
      2DUP [CHAR] . SCAN NIP 0= ABORT" File path expected" ;

: .LINES ( -- ) CR LASTLINE @  DECIMAL . ."  lines" ;
: (SAVE) ( -- ) FILENAME COUNT SAMS2FILE .LINES ;

: (PURGE) ( -- )
      PURGE-SEGMENT
      S" DSK1.UNTITLED" FILENAME PLACE
      HOMECURS  TOPLINE OFF  LASTLINE OFF  HOMECURS ;
.( .)
HEX
: ?LOAD   ( -- )
      BL PARSE-WORD DUP
      IF ( filename) ?PATH
        ." Purge " (PURGE) ." Loading"
        2DUP FILENAME PLACE
        FILE2SAMS MARK-EOF
      THEN ;

: VI ( -- )
      DECIMAL
      CLIPBASE VP !  \ set clipboard in VDP RAM
      ?LOAD
      DRAW.SCR  EDWINDOW LIST PUTCURS
      INSERTING ON
      VIMODE ;

DECIMAL
\ Forth VI99  User commands
: #VI    ( n -- ) SEGMENT VI ;
: SAVEAS ( -- ) BL PARSE-WORD ?PATH 2DUP FILENAME PLACE  (SAVE) ;
: SAVE   ( -- ) BL PARSE-WORD NIP 0> ABORT" Use SAVEAS command" (SAVE) ;
: PURGE  ( -- ) (PURGE) MARK-EOF DRAW.SCR PROMPT: ." Ready" ;
: PURGEALL ( -- )
       ." Purging SAMS Card"
        CR 11 1 DO  I DUP . SEGMENT (PURGE) MARK-EOF   LOOP
        1 SEGMENT ;

CR ." VI99 loaded. "  HERE SWAP -
DECIMAL .     .( bytes used)

 

 

  • Like 1

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...

  • Recently Browsing   1 member

×
×
  • Create New...