Foxit - in progress

GDMike · January 31, 2022

2 hours ago, Willsy said:
Quick bit of code to display an inverted string:
: .INV$ ( c-addr len -- )
  OVER + SWAP DO I C@ DUP 48 123 WITHIN IF 96 + THEN EMIT LOOP ;
  
: TEST ( -- ) S" Hello mother! 12345..." .INV$ ; 
Note: Not all characters are inverted. For example, the space character (ASCII 32). You can get around that by replacing spaces with ASCII 0. Let us know if you want the code and one of us will post it

Also, have a look at block 28 on the TOOLS disk. If you have the standard TF UTILS blocks disk in DSK1, and TOOLS in DSK2, you should be able to type TOOLS from the boot screen (assuming standard TF boot disk in DSK1) and type 28 LOAD. The code for it is below. It handles replacing spaces for you and is written in machine code so it's dead quick.
--BLOCK-00028---------
base @ hex
CODE: INVERT$
C054 C024 0002 04C2 D090 0282 8000 1A07 0282 DA00 1B03 0222
A000 D402 1009 0282 2000 1A06 0282 7A00 1B03 0222 6000 D402
0580 0601 16E9 ;CODE
base !
 
.( INVERT$ { addr len -- addr len } loaded.)
.( INVERT$ inverts a string.)
.( Eg: )
.( : TEST S" This is a test" INVERT$ TYPE ; )
: TESTi S" Test of INVERT$" 2DUP TYPE INVERT$ CR TYPE CR ;
TESTi

I'm working on this as we type...

So by the beginning of morning I'll have something.

HOME AUTOMATION · January 31, 2022

7 minutes ago, GDMike said:

Yes sir.. but not on that particular file as I thought about that after the fact lol .

But yes.

I noticed the save of R11, is also >0000 ...looks like an issue with the resolving of labels. :ponder:

GDMike · January 31, 2022

13 minutes ago, HOME AUTOMATION said:

I noticed the save of R11, is also >0000 ...looks like an issue with the resolving of labels.

That's possible. But I ended up making an branch to an absolute address to resolve that. As I kept trying different scenarios in my attempt

Edited January 31, 2022 by GDMike

GDMike · January 31, 2022

Latest... but I need to find time to pull the code out..

GDMike · January 31, 2022

What's the quickest way to pull my source code from Forth into, like text or something from classic 99? I guess not CL99.. but from something?

Edited January 31, 2022 by GDMike

+Lee Stewart · January 31, 2022

36 minutes ago, GDMike said:

What's the quickest way to pull my source code from Forth into, like text or something from classic 99?

Do you mean from a blocks file to something like Notepad++?

...lee

GDMike · January 31, 2022

I'd like to post some of my code from my blocks file

GDMike · January 31, 2022

Or else I'd have to post a photo.. and I'm not sure that's popular.

+Lee Stewart · January 31, 2022

5 minutes ago, GDMike said:

I'd like to post some of my code from my blocks file

The way I have done that is to use TI99Dir to convert the blocks file to a DOS text file (with ".txt" extension) in Editor/Assembler format (Tools—>"Convert TI File to PC File"). This will produce a text file with 128-character lines.

I then load it into Notepad++ and split the lines in half. It is a PITA, but it works and I have done it a lot! You can also create a macro to do it for you.

Before you split the lines, you should insure that "Auto-indent" is un-checked: Settings—>Preferences...—>Auto-Completion

...lee

GDMike · January 31, 2022

Yeah.. I just needed someone to tell me this...I was afraid of that. Ok...I'll work it out Tuesday..

GDMike · January 31, 2022

This is right where I wanted to be at 2:30 this morning. Looks like I made it.

I wanted a flashing cursor in my command window by morning. Because it'll be another weekend before I can make more progress.

But I'm happy

Willsy · January 31, 2022

5 hours ago, GDMike said:

I'd like to post some of my code from my blocks file

If you're using TF you can load the Block to File export utility from the standard TF disk on block 20.

If you're using Classic99 you can use it like this:

start end blk>file clip

for example:

10 20 blk>file clip

This will export blocks 10 to 20 to the Windows clipboard, and then you can paste the output straight into your notepad file. That's exactly what I did on post #401 above. Don't forget to USE the appropriate blocks file after loading block 20!

Here is the output from the command above, after loading block 20.

Spoiler

--BLOCK-00010---------
: ASM: HEADER HERE 2+ , LATEST @ HIDDEN ;
: ;ASM $045C , LATEST @ HIDDEN ;
: ?PAIRS XOR ABORT" Conditionals not paired" ;
: ERROR CR ." Block " BLK @ . ." line " >IN @ 64 / .
ABORT ;
HEX
: GOP' OVER DUP 1F > SWAP 30 < AND IF + , , ELSE + , THEN ;
: GOP CREATE , DOES> @ GOP' ;

0440 GOP B, 0680 GOP BL, 0400 GOP BLWP,
04C0 GOP CLR, 0700 GOP SETO, 0540 GOP INV,
0500 GOP NEG, 0740 GOP ABS, 06C0 GOP SWPB,
0580 GOP INC, 05C0 GOP INCT, 0600 GOP DEC,
0640 GOP DECT, 0480 GOP X,

-->

--BLOCK-00011---------
.( START OF 11)
: GROP CREATE , DOES> @ SWAP 40 * + GOP' ;
2000 GROP COC, 2400 GROP CZC, 2800 GROP XOR,
3800 GROP MPY, 3C00 GROP DIV, 2C00 GROP XOP,

: GGOP CREATE , DOES> @ SWAP DUP DUP 1F > SWAP 30 < AND
IF 40 * + SWAP >R GOP' R> , ELSE 40 * + GOP' THEN ;
A000 GGOP A, B000 GGOP AB, 8000 GGOP CMP, 9000 GGOP CB,
6000 GGOP S, 7000 GGOP SB, E000 GGOP SOC, F000 GGOP SOCB,
4000 GGOP SZC, 5000 GGOP SZCB, C000 GGOP MOV, D000 GGOP MOVB,

: 0OP CREATE , DOES> @ , ;
0340 0OP IDLE, 0360 0OP RSET, 03C0 0OP CKOF,
03A0 0OP CKON, 03E0 0OP LREX, 0380 0OP RTWP,
.( END OF 11)
-->

--BLOCK-00012---------
: ROP CREATE , DOES> @ + , ; 02C0 ROP STST, 02A0 ROP STWP,
: IOP CREATE , DOES> @ , , ; 02E0 IOP LWPI, 0300 IOP LIMI,
: RIOP CREATE , DOES> @ ROT + , , ;
0220 RIOP AI, 0240 RIOP ANDI, 0280 RIOP CI, 0200 RIOP LI,
0260 RIOP ORI,
: RCOP CREATE , DOES> @ SWAP 10 * + + , ;
0A00 RCOP SLA, 0800 RCOP SRA, 0B00 RCOP SRC, 0900 RCOP SRL,

: DOP CREATE , DOES> @ SWAP 00FF AND OR , ;
1300 DOP JEQ, 1500 DOP JGT, 1B00 DOP JH, 1400 DOP JHE,
1A00 DOP JL, 1200 DOP JLE, 1100 DOP JLT, 1000 DOP JMP,
1700 DOP JNC, 1600 DOP JNE, 1900 DOP JNO, 1800 DOP JOC,
1C00 DOP JOP, 1D00 DOP SBO, 1E00 DOP SBZ, 1F00 DOP TB,

: GCOP CREATE , DOES> @ SWAP 000F AND 40 * + GOP' ;
3000 GCOP LDCR, 3400 GCOP STCR, -->

--BLOCK-00013---------
: @() 020 ; : *? 010 + ; : *?+ 030 + ;
: @(?) 020 + ; : W 06 ; : @(W) W @(?) ;
: *W W *? ; : *W+ W *?+ ; : RP 05 ;
: @(RP) RP @(?) ; : *RP RP *? ; : *RP+ RP *?+ ;
: IP 03 ; : @(IP) IP @(?) ; : *IP IP *? ;
: *IP+ IP *?+ ; : SP 04 ; : @(SP) SP @(?) ;
: *SP SP *? ; : *SP+ SP *?+ ; : NXT 0C ;
: *NXT+ NXT *?+ ; : *NXT NXT *? ; : @(NXT) NXT @(?) ;
: GTE 1 ; : HI 2 ; : NE 3 ; : LO 4 ; : LTE 5 ; : EQ 6 ;
: OC 7 ; : NC 8 ; : OO 9 ; : HE 0A ; : LE 0B ; : NP 0C ;
: LT 0D ; : GT 0E ; : NO 0F ; : OP 10 ;
: CJMP CASE LT OF 1101 , 0 ENDOF GT OF 1501 , 0 ENDOF
NO OF 1901 , 0 ENDOF OP OF 1C01 , 0 ENDOF
DUP 0< OVER 10 > OR IF ERROR THEN DUP
ENDCASE 100 * 1000 + , ;
-->

--BLOCK-00014---------
: IF, CJMP HERE 2- 42 ; IMMEDIATE
: ENDIF, 42 ?PAIRS HERE OVER - 2- 2/ SWAP 1+ C! ; IMMEDIATE
: ELSE, 42 ?PAIRS 0 CJMP HERE 2- SWAP 42 [COMPILE] ENDIF,
42 ; IMMEDIATE
: BEGIN, HERE 41 ; IMMEDIATE
: UNTIL, SWAP 41 ?PAIRS CJMP HERE - 2/ 00FF AND HERE 1- C!
; IMMEDIATE
: AGAIN, 0 [COMPILE] UNTIL, ; IMMEDIATE
: REPEAT, >R >R [COMPILE] AGAIN, R> R> 2- [COMPILE] ENDIF,
; IMMEDIATE
: WHILE, [COMPILE] IF, 2+ ; IMMEDIATE
\ Wycove assembler register syntax:
: @@ @() ; : ** *? ; : *+ *?+ ; : () @(?) ;
: RT, R11 ** B, ; DECIMAL
.( Assembler loaded.)
.( See http://turboforth.net/assembler.html)

--BLOCK-00015---------
: PRIMES ( n - )
PAGE
2 SWAP
2 . 3 .
5 DO
DUP DUP * I <
IF 1+ THEN
1 OVER 1+ 3 DO
J I MOD 0=
IF 1- LEAVE THEN
2 +LOOP
IF I . THEN
2 +LOOP
DROP
;
PAGE 1000 PRIMES

--BLOCK-00016---------
\ Common routines for file utilities
: file-type S" DV080SI" ; FBUF: thefile FBUF: file-out
: >ftype file-type SWAP 1+ SWAP DROP SWAP CMOVE ;
: rec-len BL WORD NUMBER 0> ABORT" Invalid record length"
file-type DROP 3 + DUP 3 + SWAP DO BL I C! LOOP
N>S file-type DROP 3 + SWAP CMOVE ;
: D/V S" DV" >ftype rec-len ; : D/F S" DF" >ftype rec-len ;
: I/F S" LF" >ftype rec-len ; : I/V S" LV" >ftype rec-len ;
: open-file HERE COUNT thefile FILE thefile #OPEN
ABORT" Can't open input file" ; : out-spec S" DV080SO" ;
: get-filename BL WORD DUP -ROT HERE 1+ SWAP CMOVE DUP HERE
1+ + file-type ROT SWAP CMOVE 8 + HERE C! ;
: set-out-file BL WORD DUP -ROT HERE 1+ SWAP CMOVE DUP HERE
1+ + out-spec ROT SWAP CMOVE 8 + HERE C!
HERE COUNT file-out FILE ;
: FT? ." Configured for" file-type 2- TYPE CR ;

--BLOCK-00017---------
CR 16 CLOAD file-type
.( FTYPE - type a file to the screen.)
.( E.g. FTYPE DSK1.README)

: FTYPE ( --)
get-filename open-file CR
BEGIN thefile #EOF? NOT WHILE
HERE thefile #GET ABORT" Error reading file"
HERE COUNT -TRAILING TYPE CR
REPEAT
thefile #CLOSE CR ;

--BLOCK-00018---------
CR 16 CLOAD file-type
.( PRINT - print a file to PIO.)
.( E.g. PRINT DSK1.README)

FBUF: pio
: PRINT ( --)
S" CLIP DV80SO" pio FILE
get-filename open-file pio #OPEN ABORT" Can't open printer"
BEGIN thefile #EOF? 0= WHILE
HERE thefile #GET ABORT" Error reading file"
HERE COUNT pio #PUT ABORT" Can't write to printer"
REPEAT thefile #CLOSE pio #CLOSE ;

--BLOCK-00019---------
CR 16 CLOAD file-type
.( COPY - Copy a file.)
.( e.g. COPY DSK1.SOURCE DSK2.DESTINATION)

: COPY ( --) CR file-type DROP out-spec CMOVE
[ CHAR O LITERAL ] out-spec + 1- C!
get-filename open-file set-out-file
file-out #OPEN ABORT" Can't open output file"
BEGIN thefile #EOF? 0= WHILE
PAD thefile #GET ABORT" Error reading file"
PAD COUNT file-out #PUT ABORT" Can't write to device"
REPEAT thefile #CLOSE file-out #CLOSE ;

--BLOCK-00020---------
CR 16 CLOAD file-type TRUE VALUE cswtch
.( BLK>FILE - dumps a range of blocks to a text file.)
.( e.g. 1 21 BLK>FILE DSK2.BLKDUMP) : SZ ZEROS ! ;
: HDR cswtch NOT DUP TO cswtch IF ." On" ELSE ." Off" THEN CR ;
: BAR S" --BLOCK---------------" 2DUP >R >R DROP 8 + SWAP -1 SZ
N>S 0 SZ ROT SWAP CMOVE S" " file-out #PUT DROP R> R>
file-out #PUT ; .( HDR toggles headers on and off.)
: BLK>FILE ( start end -- ) DEPTH 2 < NOT IF
file-type DROP out-spec CMOVE
[ CHAR O LITERAL ] out-spec + 1- C!
set-out-file file-out #OPEN ABORT" Can't open output file"
1+ SWAP DO I cswtch IF BAR THEN DROP I BLOCK 16 0 DO
DUP HERE 64 VMBR HERE 64 -TRAILING DUP
IF file-out #PUT ELSE 2DROP S" " file-out #PUT THEN
DROP 64 + LOOP DROP LOOP file-out #CLOSE
ELSE TRUE ABORT" Syntax error" THEN ;

GDMike · January 31, 2022

Exactly what I need! Thank you for chiming in on that. I just put everything away for the week.. but this is just wonderful.

I was trying to get the timing on my key input routine and I got close but ran outta time.

St least that's where I'm at in the build.

Edited January 31, 2022 by GDMike

+Lee Stewart · January 31, 2022

3 hours ago, Willsy said:

If you're using Classic99 you can use it like this:

start end blk>file clip

1 hour ago, GDMike said:

Exactly what I need!

Sorry. Brain fart. I forgot about that. I have the same utility ported to fbForth!

...lee

Bill R Sullivan · January 31, 2022

6 hours ago, GDMike said:

This is right where I wanted to be at 2:30 this morning. Looks like I made it.

I wanted a flashing cursor in my command window by morning. Because it'll be another weekend before I can make more progress.

But I'm happy

Mike, I see that your laptop is a Dell. which model specifically? I have two Dell laptops, one is a Latitude E6430 and the other is a Latitude E6420. Both run Linux Mint Cinnamon.

GDMike · January 31, 2022

Oh, these things were giving to me by clients..I never even look at the make anymore... I've got 2 and it's a Dell Inspiron i5 17" and then this one that's similar and the only reason I use it is because it has an SDD drive and I don't have to wait for boot too long. But yeah, there ok...a little old, but back in the day my 17" Dell was cool..

The other just sits around the house doing nothing...no desk space for it..

Lol.

Edited January 31, 2022 by GDMike

GDMike · February 4, 2022

I've got my command window made and able to save and recall what's in it. But I'm having trouble making a KEY input routine.

I'll have to key in my existing code to show you yet..

but simply,

I've got a word that handles the cursor timing and another word that checks if a key was pressed that happens to be greater than character 31, display it if it's between a valid upper or lower case character and advance the cursor position (col), read the character at the next col position, etc... I don't need to worry about row movement, just looking for enter press. And process my string on the line..

Something like that... I've got a good timing sequence for my cursor blink rate but my repeat of character is too great, and my key response is slow at the same time. Im Working with>837C and >8375 and the TF word KEY, and I'm storing the value of>8375 to a word and working with that word to determine on wether I need to exit the routine, I'll read the complete line after enter is pressed and I will have only left/right directional keys for a left and right boundary limit.

I had this working a couple years ago, but can't seem to find that code. I'm sure I'll figure it out, but it's going to take some time.

There's a few ways to do this, I found out, and using CASE was one, but I'm not sure that would satisfy what I'm doing.

I'll be working on this tomorrow. ? Love it

Edited February 4, 2022 by GDMike

+Lee Stewart · February 4, 2022

5 hours ago, GDMike said:

But I'm having trouble making a KEY input routine.

You are welcome to my fbForth 1.0 RKEY routine (almost identical to TI Forth 40/80-column editor’s RKEY ). It will need to be modified for TurboForth, which I can do, but the comments will give you an idea how it works:

Spoiler


DECIMAL
 10 CONSTANT RL         \ loop-count for re-repeats of current char
150 CONSTANT RH         \ loop-count to start repeating current char
\ BKL should be half of BKH if you change these
 60 CONSTANT BKL        \ low blink loop-count for cursor-write
120 CONSTANT BKH        \ high blink loop-count for char-write

  0 VARIABLE BLINK      \ blink loop-count accumulator
  0 VARIABLE OKEY       \ old key
  0 VARIABLE CURCHR     \ char at cursor position
  0 VARIABLE KC         \ repeat-key count
\ RLOG = RH when waiting to start repeating current char
\ RLOG = RL when waiting to repeat current char
 RH VARIABLE RLOG       \ repeat-char loop-count wait

\ Get char at cursor position
: GCH 
   CURPOS @             \ get screen cursor position
   VSBR CURCHR ! ;      \ get char
\ Restore char to cursor position
: PCH 
   CURCHR @             \ get current char from storage
   CURPOS @ VSBW ;      \ restore char
\ Put cursor char to cursor position
: PCUR 
   30 CURPOS @ VSBW ;   \ write cursor char

: RKEY   ( -- key )  \ Stack contents are indicated by "S:..."
   BEGIN 
      ?KEY              \ ASCII of key to stack    S:key|0
      -DUP              \ DUP if not 0             S:(key key)|0
      1 BLINK +!        \ inc BLINK counter
      BLINK @           \ current BLINK value      S:(key key)|0 blink 
      DUP BKL < IF   \ blink < low blink-count?
         PCUR           \ yes..put cursor at cursor position
      ELSE
         PCH            \ no..restore char at cursor position
      THEN    
      BKH = IF    \ blink = high blink-count?      S:(key key)|0
         0 BLINK !      \ yes..reset blink
      THEN             
      IF    \ some key pressed?                    S:key
         KC @              \ repeat-key count      S:key kc
         1 KC +!           \ inc repeat-key count
         0 BLINK !         \ reset blink
         IF \ waiting to repeat (KC <> 0)?         S:key
            RLOG @         \ yes..current repeat time    S:key rlog
            KC @           \ repeat-key count      S:key rlog kc
            < IF  \ long enough to repeat char?    S:key
               RL RLOG !   \ now we're waiting for re-repeats
               1 KC !      \ set key-count to 1 for re-repeats
               1           \ exit loop at UNTIL    S:key 1
            ELSE \ not long enough to repeat char
               OKEY @      \ old key               S:key okey
               OVER = IF   \ same key, i.e., need to wait?  S:key
                  DROP     \                       S:
                  0        \ repeat loop at UNTIL  S:0
               ELSE 
                  1        \ exit loop at UNTIL    S:key 1
                  DUP KC ! \ set key-count to 1 for re-repeats S:key 1
               THEN       
            THEN                                             
         ELSE \ new key                            S:
            1              \ exit loop at UNTIL    S:1
         THEN        
      ELSE \ no key pressed                        S:key
         RH RLOG !         \ start repeat-loop count
         0 KC !            \ reset repeat-key count
         0                 \ repeat loop at UNTIL  S:key 0
      THEN    
   UNTIL                   \                       S:key
   DUP OKEY !              \ store current key as old key
   PCH     ;               \ restore char at cursor position

...lee

Bill R Sullivan · February 4, 2022

On 1/31/2022 at 12:04 PM, GDMike said:

Oh, these things were giving to me by clients..I never even look at the make anymore... I've got 2 and it's a Dell Inspiron i5 17" and then this one that's similar and the only reason I use it is because it has an SDD drive and I don't have to wait for boot too long. But yeah, there ok...a little old, but back in the day my 17" Dell was cool..

The other just sits around the house doing nothing...no desk space for it..

Lol.

I use both of mine, one has an 240GB SSD; it's the one with 8GB RAM and Linux, so extremely fast, the other only has 4GB RAM, but has a 320GB HDD, but Linux Mint only requires 2GB RAM and 32GB HDD for excellent operation.. One or the other is always connected to my local network via Dell docking station and 4 port K/V/M as previously described in PM.

Edited February 4, 2022 by Bill R Sullivan
added small correction

GDMike · February 5, 2022

Yes Bill, I'm using my Dell Inspiron 17 with classic 99. And it's fine.

"You are welcome to my fbForth 1.0 RKEY routine (almost identical to TI Forth 40/80-column editor’s RKEY ). It will need to be modified for TurboForth, which I can do, but the comments will give you an idea how it works:"

Lee, thx. I might just have to use parts of this.

Edited February 5, 2022 by GDMike

+Lee Stewart · February 5, 2022

2 hours ago, GDMike said:

"You are welcome to my fbForth 1.0 RKEY routine (almost identical to TI Forth 40/80-column editor’s RKEY ). It will need to be modified for TurboForth, which I can do, but the comments will give you an idea how it works:"

Lee, thx. I might just have to use parts of this.

Here it is for TurboForth:

Spoiler


\ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
\ * Port from fbForth to TurboForth....                         *
\ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 

DECIMAL
 10 CONSTANT RL         \ loop-count for re-repeats of current char
150 CONSTANT RH         \ loop-count to start repeating current char
\ BKL should be half of BKH if you change these
 60 CONSTANT BKL        \ low blink loop-count for cursor-write
120 CONSTANT BKH        \ high blink loop-count for char-write

VARIABLE BLINK      \ blink loop-count accumulator
VARIABLE OKEY       \ old key
VARIABLE CURCHR     \ char at cursor position
VARIABLE KC         \ repeat-key count
\ RLOG = RH when waiting to start repeating current char
\ RLOG = RL when waiting to repeat current char
VARIABLE RLOG       \ repeat-char loop-count wait
RH RLOG !           \ initialize RLOG to high repeat count

\ Define ?KEY in terms of TurboForth's KEY?
: ?KEY   ( -- key|0 )
   KEY?
   DUP 0< IF            \ -1?
      DROP 0            \ yes..leave 0 instead
   THEN     ;
: CURPOS    ( -- n )
   $A02A @              \ cursorY         S:curY
   $A02C @ *            \ screenWidth *   S:curY*scrWid
   $A028 @ +   ;        \ cursorX +       S:curY*scrWid+curX
\ Get char at cursor position
: GCH 
   CURPOS               \ get screen cursor position
   V@ CURCHR ! ;        \ get char
\ Restore char to cursor position
: PCH 
   CURCHR @             \ get current char from storage
   CURPOS V!   ;        \ restore char
\ Put cursor char to cursor position
: PCUR 
   30 CURPOS V!   ;     \ write cursor char

: RKEY   ( -- key )  \ Stack contents are indicated by "S:..."
   BEGIN 
      ?KEY              \ ASCII of key to stack    S:key|0
      ?DUP              \ DUP if not 0             S:(key key)|0
      1 BLINK +!        \ inc BLINK counter
      BLINK @           \ current BLINK value      S:(key key)|0 blink 
      DUP BKL < IF   \ blink < low blink-count?
         PCUR           \ yes..put cursor at cursor position
      ELSE
         PCH            \ no..restore char at cursor position
      THEN    
      BKH = IF    \ blink = high blink-count?      S:(key key)|0
         0 BLINK !      \ yes..reset blink
      THEN             
      IF    \ some key pressed?                    S:key
         KC @              \ repeat-key count      S:key kc
         1 KC +!           \ inc repeat-key count
         0 BLINK !         \ reset blink
         IF \ waiting to repeat (KC <> 0)?         S:key
            RLOG @         \ yes..current repeat time    S:key rlog
            KC @           \ repeat-key count      S:key rlog kc
            < IF  \ long enough to repeat char?    S:key
               RL RLOG !   \ now we're waiting for re-repeats
               1 KC !      \ set key-count to 1 for re-repeats
               1           \ exit loop at UNTIL    S:key 1
            ELSE \ not long enough to repeat char
               OKEY @      \ old key               S:key okey
               OVER = IF   \ same key, i.e., need to wait?  S:key
                  DROP     \                       S:
                  0        \ repeat loop at UNTIL  S:0
               ELSE 
                  1 KC !   \ set key-count to 1 for re-repeats S:key
                  1        \ exit loop at UNTIL    S:key 1
               THEN       
            THEN                                             
         ELSE \ new key                            S:key
            1              \ exit loop at UNTIL    S:key 1
         THEN        
      ELSE \ no key pressed                           S:
         RH RLOG !         \ start repeat-loop count
         0 KC !            \ reset repeat-key count
         0                 \ repeat loop at UNTIL     S:0
      THEN    
   UNTIL
   DUP OKEY !     \ store current key as old key      S:key
   PCH     ;      \ restore char at cursor position   S:key

I have not tested it, but it should work.

...lee

Edited February 5, 2022 by Lee Stewart
CORRECTION of code

Willsy · February 5, 2022

At first glance, the TF version needs the leading zeros removed from the variable declarations ?

+Lee Stewart · February 5, 2022

40 minutes ago, Willsy said:

At first glance, the TF version needs the leading zeros removed from the variable declarations ?

Done.

...lee

GDMike · February 5, 2022

Ahh. Yes. The "Begin" is what I was missing in my code, I was trying to do everything within a Do LOOP.

+TheBF · February 5, 2022

59 minutes ago, GDMike said:

Ahh. Yes. The "Begin" is what I was missing in my code, I was trying to do everything within a Do LOOP.

DO LOOPS are great for simple things.

They can reach out and byte you if you try and use the return stack for some temporary storage because they typically keep the looping information over there.

So BEGIN 0= UNTIL is a common loop. 0= of course can be any conditional you need.

Forth's WHILE loop is unlike any other language because it is split into two sections and you and use them any way you need to.

BEGIN

TRUE

WHILE

DO-SOMETHING

REPEAT

-OR-

BEGIN

DO-SOMETHING

TRUE?

WHILE REPEAT

-OR-

BEGIN

DO-SOMETHING

AND-SOMETHING-ELSE

AND-ANOTHER?

WHILE ( tos=true do)

LOTS-MORE STUFF

ETC. ETC. ETC.

THAT-THING-I-FORGOT

REPEAT

Foxit - in progress

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation

Recently Browsing 0 members