+TheBF Posted September 18, 2019 Author Share Posted September 18, 2019 (edited) DATA Structures in Forth 2012 Standard Forth has a new "standard" under-development but it will not use the ANS/ISO processes as was done in 1994. Getting Forth programmers to agree on something in a language that has no syntax ( ? ) is like trying to herd cats. However there are some good things that have come of it IMHO. On of the things that people love about modern hi-level languages is data structures. This can also be something people hate about Forth. Forth, per its inventor, took the approach that you should just map out the memory yourself like we do in Assembler. Give the map some meaningful names and get on with the programming. What's yer problem? Forth 2012 has standardize a way to create data structures. Here is a magic word that lets you build data structures a amazing as that may be: : +FIELD \ n <"name"> -- ; Exec: addr -- 'addr CREATE OVER , + DOES> @ + ; At compile time it creates a name in the dictionary , records an offset number in memory and adds that value to a number of the stack. The no. on the stack keeps track of the size of the data structure as we enter new fields. +FIELD is normally a "primitive" and is used to make other new fields with names that are descriptive of the data. Below is an implementation that runs on CAMEL99 Forth and should be portable with some tweeks to other TI-99 Forths. Spoiler \ Forth 2012 structures for CAMEL99 Forth : +FIELD \ n <"name"> -- ; Exec: addr -- 'addr CREATE OVER , + DOES> @ + ; \ using +field you can make your own field desciptors. : FIELD: ( n1 "name" -- n2 ; addr1 -- addr2 ) ALIGNED 1 CELLS +FIELD ; : 2FIELD: ( d1 "name" -- d2 ; addr1 -- addr2 ) ALIGNED 2 CELLS +FIELD ; : CFIELD: ( n1 "name" -- n2 ; addr1 -- addr2 ) 1 CHARS +FIELD ; : CELLS: ( n -- ) CELLS +FIELD ; \ we can add string size tests for a CHARS: field : ?STRING ( n -- n) DUP 1 256 WITHIN 0= ABORT" bad string length" ; : CHARS: ( n -- ) ?STRING CHARS +FIELD ; ( CHARS is a NOOP on 9900) And below is some test code. Spoiler \ =================================================================== \ example code: using [ ] brackets as a naming convention to \ identify structures and fields 0 ( zero on the stack accumulates the record size) FIELD: REC#] 32 CHARS: NAME] 32 CHARS: FAMILY] 64 CHARS: ADDRESS] 32 CHARS: CITY] 15 CHARS: PROV] 25 CHARS: COUNTRY] ( -- n) CONSTANT RECORD-SIZE \ record the size as a constant : BUFFER: CREATE ALLOT ; : "" ( -- addr len) S" " ; \ a null string RECORD-SIZE BUFFER: [BUFF \ and make a buffer that size : ERASE.REC 0 [BUFF REC#] ! "" [BUFF NAME] PLACE "" [BUFF FAMILY] PLACE "" [BUFF ADDRESS] PLACE "" [BUFF CITY] PLACE "" [BUFF PROV] PLACE "" [BUFF COUNTRY] PLACE ; : LOADREC 1 [BUFF REC#] ! S" Robert" [BUFF NAME] PLACE S" Odrowsky" [BUFF FAMILY] PLACE S" 116 Settlement Park Ave." [BUFF ADDRESS] PLACE S" Markham" [BUFF CITY] PLACE S" Ontario" [BUFF PROV] PLACE S" Canada" [BUFF COUNTRY] PLACE ; : PRINT# ( addr --) @ . ; : PRINT$ ( $addr --) COUNT TYPE ; : PRINTLN ( $addr --) CR PRINT$ ; : PRINT.REC CR ." Record#: " [BUFF REC#] PRINT# [BUFF FAMILY] PRINTLN ." , " [BUFF NAME] PRINT$ [BUFF ADDRESS] PRINTLN [BUFF CITY] PRINTLN [BUFF PROV] PRINTLN [BUFF COUNTRY] PRINTLN ; Of course it's Forth so if you wanted to you could do this...? \ using +field you can make your own field descriptors. 0 CONSTANT struct{ : int ( n1 "name" -- n2 ; addr1 -- addr2 ) ALIGNED 1 CELLS +FIELD ; : double ( d1 "name" -- d2 ; addr1 -- addr2 ) ALIGNED 2 CELLS +FIELD ; : char ( n1 "name" -- n2 ; addr1 -- addr2 ) 1 CHARS +FIELD ; : string ( n -- ) ?STRING CHARS +FIELD ; ( CHARS is a NOOP on 9900) : ]struct CONSTANT ; struct{ int x int y 40 string FieldName }struct ADDRESS_FIELD Edited September 18, 2019 by TheBF typos 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted September 18, 2019 Share Posted September 18, 2019 This is really cool stuff that I will need to port to fbForth 2.0! ...lee 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 18, 2019 Author Share Posted September 18, 2019 Simple Animation This is so completely trivial given the level of some of the game writers in this forum, but I had never tried animating sprites in the 1980s. So given my new automotion I wondered if I could make it easy. The game in Forth is to write a control language to let you do the job in a self-descriptive way. I think I have that with the phrase: GOLEFT 50 STEPS For the Forth student notice how we only needed CREATE and ',' (comma) to create data structures in memory. This is more like how it's done in Assembler than other high level languages. Of course if you wanted it to be more formal you could use the data structures from my previous post to create your character patterns and flip-books but it can all be done with primitive operations. Spoiler has the code, video shows the trivial animation but the concepts should be expandable for your project in Forth. Spoiler \ SPRITE ANIMATION METHOD EXAMPLE NEEDS DUMP FROM DSK1.TOOLS NEEDS SPRITE FROM DSK1.DIRSPRIT NEEDS ELAPSE FROM DSK1.ELAPSE NEEDS MOTION FROM DSK1.AUTOMOTION DECIMAL \ named numbers are easier to read 10 CONSTANT LITTLEGUY \ character # 0 CONSTANT WALKER \ sprite # 16 CONSTANT WHITE \ ============================================================ \ Character patterns are just integers compiled into CPU ram HEX CREATE MAN0 1038 , 1038 , 5410 , 1028 , \ stationary CREATE MANR1 1038 , 1038 , 5410 , 2848 , \ walk right CREATE MANR2 1038 , 1038 , 5410 , 3010 , CREATE MANR3 1038 , 1038 , 5410 , 2840 , CREATE MANL1 081C , 081C , 2A08 , 1412 , \ walk left CREATE MANL2 081C , 081C , 2A08 , 0C08 , CREATE MANL3 081C , 081C , 2A08 , 1402 , CREATE MANUP1 1038 , 1038 , 5410 , 2808 , \ walk up/down CREATE MANUP2 1038 , 1038 , 5410 , 2820 , \ ============================================================ \ A "FLIPBOOK" can be created by putting the "pattern" addresses \ in memory with a count field. \ count img1 img2 img3 etc... CREATE WALKRIGHT ( -- addr) 3 , MANR1 , MANR2 , MANR3 , CREATE WALKLEFT ( -- addr) 3 , MANL1 , MANL2 , MANL3 , CREATE WALKUP/DN ( -- addr) 3 , MANUP1 , MANUP2 , MANUP1 , \ helper words DECIMAL : ?BREAK ?TERMINAL IF STOPMOTION \ stop the automotion MAN0 LITTLEGUY CHARDEF ." ^C" ABORT THEN ; \ returns size of FLIPBOOK and the address of 1st Pattern : SIZEOF ( flipbook_addr -- addr n ) DUP CELL+ SWAP @ ; \ play a flip-book once VARIABLE SPEED 100 SPEED ! : 1STEP ( list_addr -- ) SIZEOF 0 DO PAUSE ( -- addr) \ flipbook address is on top of stack DUP @ LITTLEGUY CHARDEF \ fetch pattern, write to VDP RAM CELL+ \ advance to next cell of flipbook SPEED @ MS \ delay in milli-seconds ?BREAK LOOP DROP \ we are finished with the pattern ; : STEPS ( list n -- ) 0 ?DO DUP 1STEP LOOP DROP ; \ put automotion and animated flipbooks together : GOLEFT ( -- list) 0 -4 WALKER MOTION WALKLEFT ; : GORIGHT ( -- list) 0 4 WALKER MOTION WALKRIGHT ; : GODOWN ( -- list) 4 0 WALKER MOTION WALKUP/DN ; : GOUP ( -- list) -4 0 WALKER MOTION WALKUP/DN ; : DEMO ( -- ) \ chr colr Y X Sp# \ ------------------------------------ LITTLEGUY WHITE 10 0 WALKER SPRITE 1 MAGNIFY SPR# @ MOVING \ tell automotion how many sprites are moving CLEAR AUTOMOTION GORIGHT 50 STEPS GODOWN 30 STEPS GOLEFT 50 STEPS GOUP 30 STEPS MAN0 LITTLEGUY CHARDEF STOPMOTION ; SIMPLE ANIMATION.mp4 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 29, 2019 Author Share Posted September 29, 2019 Surprising Editor Code One of the things on the todo list for CAMEL99 Forth is a resident editor. Since CAMEL99 uses DV80 files for editing my old code for Forth BLOCK editors was not exactly what I needed. I took look around the "inter-web" to see if there might be some Forth code I could adapt. The only editor that I found that looked interesting was one called VIBE written by Samuel Falvo. Vibe is written in the style of VI or VIM editors first seen in UNIX. These editors have 2 modes. A command mode which let's you do things without touching the text and an 'insert' mode that lets you type text. It's a bit strange compared to what we normally expect but I read that many people love it especially for system work. When I looked at the code it was very Forthy with short, single line definitions, that were woven together, as the code developed, to make the editor. Typically a text editor needs a big CASE statement or a bunch of IF statements as a selector to deal with command keys versus the alphanumeric keys that we enter into the text. However I could not find a CASE statement of any kind to deal with the keyboard inputs in VIBE. What I found instead was fascinating. The author of Forth, Chuck Moore often said that the Forth dictionary of words is a big case statement. He preferred to let the code determine what gets executed rather than setting data in variables and acting on the data. VIBE takes more of that approach. Here is how it works. Make a string variable "$$___" where underscore is a binary zero (0) Name all the routines for the editor functions using this encoding. ( Example: "$$i0D" is the enter key routine name, Key= hex 0D) When keys are pressed, Modify this "command string" by changing the zeros to other values to make new commands. Pass this string to the FORTH lookup routine (FIND) and if the word is found, EXECUTE it. If it's not found, beep. Here are the comments from the code itself that explains the command string. \ CMD name key: $ $ _ _ _ \ | | | \ 'c'=command mode --+ | | \ 'i"=ins/repl mode | | \ | | \ Key code (hex#) -----+-+ I made a few changes that saved space for the TI-99 and I changed the default Forth TYPE word with a version that used VMBW for faster screen updates. Once I figured it out, it actually worked as you can see in the video. The spoiler has the code. Spoiler \ VIBE Release 2.2 \ Copyright (c) 2001-2003 Samuel A. Falvo II \ All Rights Reserved \ \ Highly portable block editor -- works under nearly every ANS Forth \ I can think of, and with only a single screenful of words, will \ work under Pygmy and FS/Forth too. \ \ USAGE: vibe ( n -- ) Edits block 'n'. Sets SCR variable to 'n'. \ ed ( -- ) From Pygmy. Re-edits last edited block. \ \ \ 2.1 -- Fixed stack overflow bugs; forgot to DROP in the non-default \ key handlers. \ \ 2.2 Ported to CAMEL99 Forth with Permission B. Fox 2019 \ Removed some character oonstants to save space. \ Changed TYPE for VTYPE. Added CLIP. \ Removed shadow block function \ Added some block navigation commands NEEDS DUMP FROM DSK1.TOOLS NEEDS 80COLS FROM DSK1.80COL NEEDS BLOCK FROM DSK1.BLOCKS HERE ( Editor Constants ) CHAR i CONSTANT 'i \ Insert mode \ CHAR r CONSTANT 'r \ Replace mode CHAR c CONSTANT 'c \ Command mode \ CHAR y CONSTANT 'y \ CHAR n CONSTANT 'n \ CHAR A CONSTANT 'a \ CHAR Z CONSTANT 'z \ CHAR $ CONSTANT '$ \ camel99 values DECIMAL 64 CONSTANT LWIDTH C/L@ CONSTANT WIDTH 80 CONSTANT MAXBLKS ( Editor State ) VARIABLE SCR \ Current block VARIABLE X \ Cursor X position 0..LWIDTH VARIABLE Y \ Cursor Y position 0..15 VARIABLE MODE \ current mode: INSERT or command ( 'i OR 'c \ CMDNAME the command string, is built, found and executed CREATE CMDNAME 5 C, CHAR $ C, CHAR $ C, 0 C, 0 C, 0 C, ( Editor Display ) DECIMAL : MODE. LWIDTH 0 AT-XY MODE @ EMIT ; : VTYPE ( addr len -- ) DUP >R VPOS SWAP VWRITE R> VCOL +! ; \ VDP fast write : SCR. 0 0 AT-XY S" Block: " VTYPE SCR @ . S" " VTYPE ; : HEADER SCR. MODE. ; : 8-S S" --------" VTYPE ; : WIDTH-S 8-S 8-S 8-S 8-S 8-S ; : BORDER SPACE WIDTH-S CR ; : ROW ( addr -- addr') DUP LWIDTH VTYPE LWIDTH + ; \ FAST \ : ROW ( addr -- addr') DUP LWIDTH TYPE LWIDTH + ; \ SLOW : LINE ." |" ROW CR ; : 4LINES LINE LINE LINE LINE ; : 16LINES SCR @ BLOCK 4LINES 4LINES 4LINES 4LINES DROP ; : CARD 0 1 AT-XY BORDER 16LINES BORDER ; : CURSOR X @ 1+ Y @ 2 + AT-XY ; : SCREEN HEADER CARD CURSOR ; ( Editor State Control ) : INSERT 'i MODE ! ; : REPLACE [CHAR] r MODE ! ; : CMD 'c MODE ! ; : CLIP ROT MIN MAX ; : BOUNDED ( addr n -- ) 0 MAXBLKS CLIP SWAP ! ; : PREVBLOCK SCR DUP @ 1- BOUNDED ; : NEXTBLOCK SCR DUP @ 1+ BOUNDED ; \ : TOGGLESHADOW 1 SCR @ XOR SCR ! ; ( Editor Cursor Control ) : FLUSHLEFT 0 X ! ; : BOUNDX X @ 0 LWIDTH CLIP X ! ; : BOUNDY Y @ 0 15 CLIP Y ! ; : BOUNDXY BOUNDX BOUNDY ; : LEFT -1 X +! BOUNDXY ; : RIGHT 1 X +! BOUNDXY ; : UP -1 Y +! BOUNDXY ; : DOWN 1 Y +! BOUNDXY ; \ : beep 7 EMIT ; : NEXTLINE Y @ 15 < IF FLUSHLEFT DOWN THEN ; : NEXT X @ LWIDTH = IF NEXTLINE EXIT THEN RIGHT ; ( Editor Insert/Replace Text ) : WIDTH* 6 LSHIFT ; \ 2* 2* 2* 2* 2* 2* : WHERE SCR @ BLOCK SWAP WIDTH* + SWAP + ; : WH X @ Y @ WHERE ; : EOL LWIDTH Y @ WHERE ; : PLACE WH C! UPDATE NEXT ; : -EOL? X @ LWIDTH < ; : OPENR WH DUP 1+ LWIDTH X @ - MOVE ; : OPENRIGHT -EOL? IF OPENR THEN ; : INSERTING? MODE @ 'i = ; : CHR INSERTING? IF OPENRIGHT THEN PLACE ; ( Editor Keyboard Handler CMDWORD encoding) \ CMD name key: $ $ _ _ _ \ | | | \ 'c'=command mode --+ | | \ 'i"=ins/repl mode | | \ | | \ Key code (hex#) -----+-+ \ \ Called with ( k -- ) where k is the ASCII key code. ( Editor COMMANDS: Quit, cursor, block, et. al. ) ( Modified for Ti-99 keyboard ) : $$c51 DROP 0 20 AT-XY R> R> DROP >R ; \ Q -- quits main loop : $$c30 DROP FLUSHLEFT ; \ 0 : $$c69 DROP INSERT ; \ i : $$c49 DROP FLUSHLEFT INSERT ; \ I : $$c52 DROP REPLACE ; \ R : $$i0F DROP CMD ; \ (escape) GOTO command mode : $$c68 DROP LEFT ; \ h : $$c6A DROP DOWN ; \ j : $$c6B DROP UP ; \ k : $$c6C DROP RIGHT ; \ l : $$c5B DROP PREVBLOCK ; \ [ \ : $$c5C DROP TOGGLESHADOW ; \ \ : $$c5D DROP NEXTBLOCK ; \ ] ( Editor Backspace/Delete ) : PADDING 32 EOL C! UPDATE ; : DEL WH DUP 1+ SWAP LWIDTH X @ - MOVE ; : DELETE -EOL? IF DEL THEN PADDING ; : BS LEFT DELETE ; : BACKSPACE X @ 0 > IF BS THEN ; ( Editor Carriage Return ) : NEXTLN EOL 1+ ; : #CHRS SCR @ BLOCK 1024 + NEXTLN - WIDTH - ; : COPYDOWN Y @ 14 < IF NEXTLN DUP WIDTH + #CHRS MOVE THEN ; : BLANKDOWN NEXTLN WIDTH 32 FILL UPDATE ; : SPLITDOWN WH NEXTLN 2DUP SWAP - MOVE ; : BLANKREST WH NEXTLN OVER - 32 FILL ; : OPENDOWN COPYDOWN BLANKDOWN ; : SPLITLINE OPENDOWN SPLITDOWN BLANKREST ; : RETRN INSERTING? IF SPLITLINE THEN FLUSHLEFT NEXTLINE ; : RETURN Y @ 15 < IF RETRN THEN ; ( Editor Wipe Block ) : MSG 0 20 AT-XY ." Are you sure? (Y/N) " ; : VALID? DUP [CHAR] n = OVER [CHAR] y = OR ; : UPPERCASE? DUP [CHAR] a [CHAR] z 1+ WITHIN ; : LOWERCASE DUP UPPERCASE? IF BL XOR THEN ; : VALIDKEY BEGIN KEY LOWERCASE VALID? UNTIL ; : CLRMSG 0 20 AT-XY WIDTH SPACES ; : NO? MSG VALIDKEY CLRMSG [CHAR] n = ; : ?CONFIRM NO? IF R> DROP THEN ; : WIPE ?CONFIRM SCR @ BLOCK 1024 32 FILL UPDATE 0 X ! 0 Y ! ; ( Editor Commands: backspace, delete, et. al. ) : $$i04 DROP DELETE ; \ CTRL-D : $$i08 DROP BACKSPACE ; \ (bs) \ : $$i7F DROP BACKSPACE ; \ DEL -- for Unix : $$i0D DROP RETURN ; \ (cr) : $$c5A DROP WIPE ; \ Z : $$c6F DROP OPENDOWN DOWN $$c49 ; \ o : $$c4F DROP OPENDOWN ; \ O \ : $$i95 DROP X OFF Y OFF ; \ PC "HOME" key HEX 0F CONSTANT $0F F0 CONSTANT $F0 : KEYBOARD KEY 7F AND ; \ for TI-99 we need to mask upper bit DECIMAL : CMD? MODE @ 'c = ; : INS? MODE @ 'i = MODE @ [CHAR] r = OR ; : MODE! INS? 'i AND CMD? 'c AND OR CMDNAME 3 + C! ; : >HEX DUP 9 > IF 7 + THEN [CHAR] 0 + ; : H! DUP $F0 AND 4 RSHIFT >HEX CMDNAME 4 + C! ; : L! $0F AND >HEX CMDNAME 5 + C! ; : NAME! MODE! H! L! ; : NOMAPPING DROP ['] BEEP CMD? AND ['] CHR INS? AND OR ; : HANDLERWORD NAME! CMDNAME FIND 0= IF NOMAPPING THEN ; : HANDLER DUP HANDLERWORD EXECUTE ; : ?BREAK ?TERMINAL ABORT" *BREAK*" ; : EDITOR 'c MODE ! BEGIN KEYBOARD HANDLER SCREEN ?BREAK AGAIN ; \ BF commsnds : VI ( --) PAGE SCREEN EDITOR ; : VIBE ( n -- ) SCR ! VI ; : LIST ( n -- ) SCR ! PAGE SCREEN 3 19 AT-XY ; : >> SCR @ 1+ LIST ; : << SCR @ 1- LIST ; : INDEX ( from to -- ) 1+ SWAP ?DO CR I 4 .R 2 SPACES I BLOCK 64 TYPE ?BREAK LOOP ; HERE SWAP - DECIMAL . .( bytes) S" DSK3.FBLOCKS" OPEN-BLOCKS VIBE_EDITOR.mp4 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 30, 2019 Author Share Posted September 30, 2019 Exploring a VDP Screen Editor In another topic there is a discussion of editing screen contents that can be passed to the interpreter like the C64 does. I have some code that is working except for the insert function so I will publish when it's all working. An outcome of the work however is a simplification of the KEY word in future versions of Camel99 Forth. I was using the interrupt timer to control the speed of the flashing cursor. That seemed to require ALC to make it work. It was needlessly complicated. I realized that I could use the 9901 timer that I have running continuously to do the job in Forth and it saved a couple of bytes. It is also easier to understand. \ cursor flash control is done by reading the 9901 timer (thanks Tursi) \ It counts down from >3FFF in 349mS so 1FFF is 1/2 the maximum value. \ If the timer > 1FFF we show the cursor else we show a blank char \ Cursor flash rate is 349 / 2 = 124ms : KEY ( -- char) BEGIN \ start the loop TMR@ 1FFF > \ 9901>1FFF ? IF CURS @ \ true? fetch the cursor char ELSE BL \ false? get the screen char THEN VPUT \ then put on screen KEY? \ check the keyboard ?DUP \ DUP IF <> 0 UNTIL \ loop until a key pressed BL VPUT ; \ put the space char on screen P.S. If ... you can cursor around and edit the VDP screen, you could also save the screen to a file. ? P.P.S. You could also spill the screen off into memory and make it a window into a big buffer with a pointer or two... I'm just saying. 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted September 30, 2019 Share Posted September 30, 2019 On 9/29/2019 at 12:31 PM, TheBF said: When I looked at the code it was very Forthy with short, single line definitions, that were woven together, as the code developed, to make the editor. Typically a text editor needs a big CASE statement or a bunch of IF statements as a selector to deal with command keys versus the alphanumeric keys that we enter into the text. However I could not find a CASE statement of any kind to deal with the keyboard inputs in VIBE. What I found instead was fascinating. TI Forth and fbForth 1.0 indeed do use a 16-part CASE statement for the 40-column editor. fbForth 2.0, however, is programmed in ALC and uses a jump table for all but 3 commands that have inconvenient values for the table. I do love the command structure in your editor—very clever! ...lee Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 30, 2019 Author Share Posted September 30, 2019 1 hour ago, Lee Stewart said: TI Forth and fbForth 1.0 indeed do use a 16-part CASE statement for the 40-column editor. fbForth 2.0, however, is programmed in ALC and uses a jump table for all but 3 commands that have inconvenient values for the table. I do love the command structure in your editor—very clever! ...lee I can't take credit. It's all Sam Falvo, who is a pretty big Forth programmer as far as I can determine. He has a good mind for sure. I would never have considered that this would work fast enough. In fact I was worried that the lookup time on a TI99 Forth would make it glacial for typing. It's not fast, but it works. These are the kind of solutions people come up with when they let go of preconceptions. I love it too. Back to the more conventional, I have a working file type editor with basic functions. It started as an attempt to read Forth commands off the screen like C64 BASIC. That part is ready to implement but I got distracted once I had an editor on the screen. Because I used all the screen description variables in the kernel it seems to work fine in 80 columns or 40 columns! I took the approach of using the screen memory as the active buffer. My hope is to slide the screen over the file buffer like a window. I am trying to keep it simple so it will probably be a true 40 column editor on a stock TI-99. Not sure if that's usable. We shall see. I am pretty excited about getting it loading and saving files. Almost there. On of the things I wanted to solve was alternately displaying the cursor and the character under the cursor so I made a new version of KEY. Now I have to get it repeating. : EDITKEY ( -- char) \ non-repeating KEY VPOS VC@ >R \ Read screen char & RPUSH BEGIN \ start the loop TMR@ 1FFF > \ read 9901 timer. compare to >2000 IF CURS @ \ true? fetch cursor char ELSE R@ \ false? fetch screen char THEN VPUT \ multi-tasking friendly screen write KEY? \ check the keyboard ?DUP \ DUP IF <> 0 UNTIL \ loop until a key pressed R> VPUT ; \ RPOP the screen char, put it back 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted October 1, 2019 Share Posted October 1, 2019 54 minutes ago, TheBF said: On of the things I wanted to solve was alternately displaying the cursor and the character under the cursor so I made a new version of KEY. Now I have to get it repeating. I do not know that it will help, but here is the ALC for RKEY , the key routine in the 40/80-column editor in fbForth 2.0. ;[*++ RKEY ++* Get next key and repeats *++ RKEY is key acquisition/repetition and cursor blinking routine. *++ *++ Register usage: RKEY DECT R ; make room on return stack to... MOV LINK,*R ; ...save return RKEYLP LIMI 0 ; disable interrupts because KSCAN doesn't BLWP @KSCAN ; scan the keyboard (interrupts will be enabled at end) INC @BLINK ; increment blink logger LI R3,180 ; load 180 C @BLINK,R3 ; has it been 180 clicks? JLT RKEY01 ; jump if not MOVB @CURCH,R1 ; copy character under cursor JMP RKEY02 ; restore it RKEY01 LI R1,>1E00 ; load cursor character RKEY02 BL @PCHCUR ; display cursor or char under cursor SLA R3,1 ; load 360 C @BLINK,R3 ; has it been 360 clicks? JNE RKEY03 ; jump if not CLR @BLINK ; clear blink logger RKEY03 CB @KYCHAR,@CONFF ; no key? JEQ RKEY05 ; jump if so *++ We have a key! SZCB @CN8000,@KYCHAR ; force KYCHAR byte to ASCII MOV @KC,R3 ; save key counter for test INC @KC ; increment key counter for wait CLR @BLINK ; zero blink logger MOV R3,R3 ; waiting to repeat? JEQ RKEYEX ; finish up and exit if not *++ waiting to repeat C @RLOG,@KC ; long enough? JLT RKEY04 ; jump if so *++ We may not have waited long enough yet. CB @OKEY,@KYCHAR ; same key? JEQ RKEYLP ; wait some more if same key *++ We're outta here! MOV @CON01,@KC ; load key counter with 1 JMP RKEYEX ; finish up *++ we've waited long enough RKEY04 MOV @RL,@RLOG ; load short wait time for repeat logger MOV @CON01,@KC ; load key counter with 1 JMP RKEYEX ; clean up and back to editor loop *++ No key was pressed. RKEY05 MOV @RH,@RLOG ; re-init RLOG CLR @KC ; zero key counter JMP RKEYLP ; scan keyboard again *++ End of RKEY processing RKEYEX MOVB @KYCHAR,@OKEY ; current key to old key MOVB @CURCH,R1 ; character under cursor to R1 BL @PCHCUR ; restore it to display MOV *R+,LINK ; pop return address B @BKLINK ; return to caller, possibly re-enabling interrupts ...lee 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 1, 2019 Author Share Posted October 1, 2019 Thank you. It will surely give me an algorithm. I will just try to do it Forth. (Structured loops might make it harder) Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 1, 2019 Author Share Posted October 1, 2019 (edited) Here is cute little tool. While thinking about a repeating KEY routine I was noodling on how to time the delays that are needed. I created the counter which is a variable that decrements itself down to zero. It's not a real time delay but it lets you count how many times you ran through a loop without thinking about it. When the counter returns 0 you can do something. This might make a repeating KEY easier to make... Edit: made COUNTERs reloadable : COUNTER: ( n -- <text>) CREATE DUP , , DOES> DUP @ IF -1 OVER +! THEN @ ; : RELOAD ' >BODY DUP CELL+ @ SWAP ! ; Edit2: Making reload work for compiling will hurt my head and not really worth the trouble. I can do it with a simple 2VARIABLE and decrement to 0 word. ? Edited October 1, 2019 by TheBF 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 1, 2019 Author Share Posted October 1, 2019 A Better Counter : COUNTER: ( n -- <text>) CREATE DUP , , ; : EXPIRED? ( counter -- ?) DUP @ IF -1 OVER +! THEN @ 0= ; : RELOAD ( counter -- ) DUP CELL+ @ SWAP ! ; I find that using CREATE DOES> is best kept for special cases. I know Chuck Moore decided to not use it in his personal Forth compilers these days. 1 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 4, 2019 Author Share Posted October 4, 2019 Repeating Key in Forth (Cleaned up version) Reduced to two working words to save a little space. Now I can get on with finishing the editor. Spoiler \ RKEY, A repeating KEY word \ algorithm from \ http://www.unige.ch/medecine/nouspikel/ti99/keyboard.htm#auto-repeat \ NEEDS DUMP FROM DSK1.TOOLS DECIMAL 70 CONSTANT LONG \ Ticks before auto-repeat kicks in 2 CONSTANT SHORT \ Delay between repeats \ Not very Forthy using all these variables VARIABLE DLY \ Current delay & "state" variable VARIABLE NEWKEY \ key buffer VARIABLE OLDKEY \ previous key buffer HEX : (RKEY) ( -- ) DLY @ LONG = \ Are we repeating? IF LONG DLY ! \ No, use long delay THEN DLY @ 0 DO 83C8 ON \ KSCAN will repeat KEY? DUP NEWKEY ! OLDKEY @ <> \ different than before? IF NEWKEY @ OLDKEY ! \ Memorize current key (will be >00 if no key) LONG DLY ! \ reload initial delay UNLOOP EXIT \ jump out of the routine (to the semi-colon ) THEN LOOP SHORT DLY ! \ Done with waiting: load repeat delay ; : RKEY ( -- char) VPOS VC@ >R \ store char under cursor BEGIN TMR@ 1FFF > \ read 9901 timer. compare to >2000 IF CURS @ \ true? fetch cursor char ELSE R@ \ false? fetch screen char THEN VPUT \ multi-tasking friendly screen write (RKEY) NEWKEY @ \ get the newkey value ?DUP UNTIL R> VPUT ; \ put the char back \ =====[ END OF CODE ]===== : TEST ( -- ) BEGIN RKEY EMIT ?TERMINAL UNTIL ; 3 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted October 4, 2019 Share Posted October 4, 2019 FYI, here is the Forth code I converted to the ALC of post #408: Spoiler DECIMAL 0 VARIABLE CURCHR \ CURCHR = char under cursor : GCH \ get char at cursor position ( CURPOS ) ...used by: VED CURPOS @ VSBR CURCHR ! ; : PCH \ put current char to cursor position ...used by: RKEY CURCHR @ CURPOS @ VSBW ; : PCUR \ put cursor to cursor position ...used by: RKEY 30 CURPOS @ VSBW ; \ RKEY required variables 0 VARIABLE BLINK 0 VARIABLE OKEY 10 CONSTANT RL 150 CONSTANT RH 0 VARIABLE KC RH VARIABLE RLOG : RKEY ( -- key ) \ Used by: VED BEGIN ?KEY -DUP 1 BLINK +! BLINK @ DUP 60 < IF PCUR ELSE PCH THEN 120 = IF 0 BLINK ! THEN IF \ ...some key is pressed KC @ 1 KC +! 0 BLINK ! IF \ ...waiting to repeat RLOG @ KC @ < IF \ ...long enough RL RLOG ! 1 KC ! 1 \ force exit ELSE OKEY @ OVER = IF DROP 0 \ need to wait more ELSE 1 \ force exit DUP KC ! THEN THEN ELSE \ new key 1 \ force loop exit THEN ELSE \ no key pressed RH RLOG ! 0 KC ! 0 THEN UNTIL DUP OKEY ! PCH ; ...lee 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 4, 2019 Author Share Posted October 4, 2019 Well that certainly explains my difficulties. I struggle with those long logic trees. I haven't written code like that for years, probably since I read "Thinking Forth". Clearly there is a place for it sometimes. If I had the logic in my mind my tendency now would be to encapsulate a lot of the logic in little conditional words to help my feeble mind cope. It is very interesting to compare the two versions. I was struggling with the forced exits which I see in your example is handled by playing with the stack value that is controlling the BEGIN/UNTIL loop. I was trying to avoid that but I see I could have gone there. I could have kept it simple (for me) to understand by using another variable just to get it working. I haven't got firm numbers yet but a manual byte count of the Nouspikel example and my Forth version showed similar size, Forth being about 10% bigger. A quick count on the nested IF THEN version is significantly bigger because the IF and ELSE consume 4 bytes each. I believe this code is from the original TI-Forth (?) I notice now when I review it in my old listings that the young engineers who wrote it were probably new to Forth and the code style many times is like 'C' converted to Forth. Thanks for sending this along. I will play with it... after I recover from my latest marathon. 1 Quote Link to comment Share on other sites More sharing options...
GDMike Posted October 4, 2019 Share Posted October 4, 2019 Fun. Can't wait to try it. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 4, 2019 Author Share Posted October 4, 2019 "To gain knowledge add a little every day. To gain wisdom remove a little everyday." Anon. I always hated the if statement at the beginning of (RKEY). Turns out if you just init the DLY variable you don't need it. It has only 2 states LONG or SHORT. DECIMAL 70 CONSTANT LONG \ Ticks before auto-repeat kicks in 2 CONSTANT SHORT \ Delay between repeats \ Not very Forthy using all these variables VARIABLE DLY \ Current delay & "state" variable VARIABLE NEWKEY \ key buffer VARIABLE OLDKEY \ previous key buffer LONG DLY ! \ init this variable HEX : (RKEY) ( -- ) DLY @ 0 DO RKEY? DUP NEWKEY ! OLDKEY @ <> \ different than before? IF NEWKEY @ OLDKEY ! \ Memorize current key (will be >00 if no key) LONG DLY ! \ reload initial delay UNLOOP EXIT \ jump out of the routine (to the semi-colon ) THEN LOOP SHORT DLY ! \ Done with waiting: load repeat delay ; : RKEY ( -- char) VPOS VC@ >R \ store char under cursor BEGIN TMR@ 1FFF > \ read 9901 timer. compare to >2000 IF CURS @ \ true? fetch cursor char ELSE R@ \ false? fetch screen char THEN VPUT \ multi-tasking friendly screen write (RKEY) NEWKEY @ \ get the newkey value ?DUP UNTIL R> VPUT ; \ put the char back Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted October 4, 2019 Share Posted October 4, 2019 3 hours ago, TheBF said: Well that certainly explains my difficulties. I struggle with those long logic trees. I haven't written code like that for years, probably since I read "Thinking Forth". Clearly there is a place for it sometimes. If I had the logic in my mind my tendency now would be to encapsulate a lot of the logic in little conditional words to help my feeble mind cope. Yeah, I made only minor changes to the original code from the 64-column editor of TI Forth. I should have made more where the stack number for UNTIL was concerned. That is a little less than satisfactory, indeed. The only real difference is the last word ( PCH ), which restores the character under the cursor before exiting RKEY . This was necessary because there is no text-mode analog to the sprite cursor in the bitmap mode of the 64-column editor. 3 hours ago, TheBF said: I believe this code is from the original TI-Forth (?) I notice now when I review it in my old listings that the young engineers who wrote it were probably new to Forth and the code style many times is like 'C' converted to Forth. Here is the original RKEY from the 64-column editor by Leslie O’Hagan: Spoiler : RKEY BEGIN ?KEY -DUP 1 BLINK +! BLINK @ DUP 60 < IF 6 0 SPRPAT ELSE 5 0 SPRPAT ENDIF 120 = IF 0 BLINK ! ENDIF IF ( SOME KEY IS PRESSED ) KC @ 1 KC +! 0 BLINK ! IF ( WAITING TO REPEAT ) RLOG @ KC @ < IF ( LONG ENOUGH ) RL RLOG ! 1 KC ! 1 ( FORCE EXIT) ELSE OKEY @ OVER = IF DROP 0 ( NEED TO WAIT MORE ) ELSE 1 ( FORCE EXIT ) DUP KC ! ENDIF ENDIF ELSE ( NEW KEY ) 1 ( FORCE LOOP EXIT ) ENDIF ELSE ( NO KEY PRESSED) RH RLOG ! 0 KC ! 0 ENDIF UNTIL DUP OKEY ! ; Leslie O’Hagan wrote this editor about a week after Leon Tietz wrote the 40-column editor, which, by the way, had no repeats. It simply used the TI Forth KEY routine from the TI Forth system-support routines (includes cursor blink) that the outer (text) interpreter uses. I had often thought of changing KEY to act like RKEY to get the key repeat, but ran out of steam or patience—I forget which. ...lee Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 4, 2019 Author Share Posted October 4, 2019 So just for the sake of analysis here are some code size comparisons: Nouspikel ALC 92 bytes BF translation of Nouspikel 198 bytes *TI-Forth RKEY 330 bytes So my 10% estimate was way off. There are about 60 bytes if LABEL and dictionary overhead in my Forth version. * slightly modified to compile and work on Camel99 Forth for direct comparison Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 4, 2019 Author Share Posted October 4, 2019 Wow you know all the history. I remember playing with that RKEY routine in the 64 column editor. I forget what I did to it. I recently dumped my blocks to the serial port so here is what I have: ( 64 COLUMN EDITOR 15JUL82 LAO ) BASE->R DECIMAL 0 VARIABLE BLINK 0 VARIABLE OKEY 10 CONSTANT RL 40 CONSTANT RH 0 VARIABLE KC RH VARIABLE RLOG : GKEY BEGIN ?KEY -DUP 1 BLINK +! BLINK @ DUP 60 < IF CURSON ELSE CURSOFF ENDIF 120 = IF 0 BLINK ! ENDIF IF ( some key is pressed ) KC @ 1 KC +! 0 BLINK ! IF ( waiting to repeat ) RLOG @ KC @ < IF ( long enough ) RL RLOG ! 1 KC ! 1 ( FORCE EXT) ELSE OKEY @ OVER = IF ( need to wait more ) DROP 0 ELSE 1 ( force exit ) DUP KC ! ENDIF ENDIF ELSE ( new key ) 1 ( force loop exit ) ENDIF ELSE ( no key pressed) RH RLOG ! 0 KC ! 0 ENDIF UNTIL DUP OKEY ! ; R->BASE --> LOL! I should have looked here first. But then I would not have made the new one. 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 6, 2019 Author Share Posted October 6, 2019 On 10/4/2019 at 12:07 PM, TheBF said: So just for the sake of analysis here are some code size comparisons: Nouspikel ALC 92 bytes BF translation of Nouspikel 198 bytes *TI-Forth RKEY 330 bytes So my 10% estimate was way off. There are about 60 bytes if LABEL and dictionary overhead in my Forth version. * slightly modified to compile and work on Camel99 Forth for direct comparison Manually counting FBFORTH ALC it is in the 152 byte range, so a big improvement on the original TI-Forth version. Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted October 6, 2019 Share Posted October 6, 2019 On 10/4/2019 at 12:07 PM, TheBF said: Nouspikel ALC 92 bytes Not to put too fine a point on it, but I get 108 bytes when I assemble Thierry’s code, which includes its local workspace. ...lee Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 6, 2019 Author Share Posted October 6, 2019 Excellent. I just attempted to count bytes from the source code. I missed a few! Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 11, 2019 Author Share Posted October 11, 2019 (edited) ED99 Beginnings I have been threatening to write an editor for CAMEL99 Forth for some time. I reached into the archive and found an editor that wrote in 1985 for MVP Forth that I just called "ED". I ported it to HsForth in the 90s and now to CAMEL99 Forth in the 21st Century. Truth be told it's a complete re-write because I think I have learned a thing or two about Forth since writing this system. As a result of ripping up and starting over it's still buggy. You can load,edit and save and file but I still have work to do. The design is a little weird but it is because of the limited memory in the TI-99 for big files. I use virtual memory file of 128 byte records to hold the file while working on it. This uses the Forth word BLOCK which gives you 1K blocks of disk that are stored in buffers and automagically paged in and out on demand. I create a swap-file on the disk that is 64Kb long and it is re-used. This allows files of over 1000 *500 lines to be edited. It's very crude however, If you insert a new line at the top of a 1000 line file be prepared to wait for about 8 seconds!! * There are only 3 kinds of people. Those that can do math and those that can't) The current version is to get the kinks out it and uses 80 columns because it's just easier to get started. I will add support for 40 columns later so I can use it my old IRON. Something that I always loved with the TI-FORTH 64 column editor was having a Forth REPL window under the source code so I create that here. This allows me to save a ton of code because I can use the command line for things that are not "text editing" per se. Currently the commands are: LOAD <filename> SAVE Save the loaded file with the same name SAVEAS <filename> saves loaded file as <filename> SWAPDEV <DSKx.> Sets the disk for the swapfile NEWBLOCKS Create a new swapfile EDIT Enter editor window at cursor position ED99 open swap-file, init the screen >> goto next page << goto previous page VIEW scroll through the file in the editor window PURGE Erase the entire swapfile. Having the interpreter means it is simple to make a config file to setup screen colors and disk selections on start-up. I will also add SEARCH and REPLACE as text commands once things are stable. Cut and paste will use a stack (what else in Forth) of lines that can be pasted back in difference places as needed. I will eventually port it to use SAMS as the BLOCK structure instead of a file but this version will work with a 32K card. ED99 PRELIM.mp4 Edited October 11, 2019 by TheBF Math mistake 4 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 20, 2019 Author Share Posted November 20, 2019 I haven't posted much here because I was distracted by the SEVEN's problem. That program pointed out that my VDP screen I/O was a little slow. This is not a surprise since much of it is written in Forth for instructional purposes. I can re-compile the kernel in 5 seconds and run it, so I am always playing in CAMEL99 Forth to find what really matters for performance while trying to fit it into 8K. I discovered that my SCROLL ROUTINE was a little slow. It uses Forth and a couple of Assembler routines to similar to VSBW and VMBW. It's got a bit of stack juggling in it which slows it down a bit. You can vary the buffer size in the Kernel build from 1,2,4 or 8 lines by changing the multiplier in 2C/L and it certainly improves in speed with a bigger buffer. It looks like this. CODE: 2C/L ( -- n) CODE[ C/L@ 2* ] NEXT, END-CODE : SCROLL ( -- ) PAUSE 2C/L DUP MALLOC ( -- n heap) C/SCR @ C/L@ VTOP @ + ( -- n heap c/scr DSTvaddr) DO I ( -- c/scr heap vaddr) OVER 2DUP 2C/L VREAD SWAP C/L@ - 2C/L VWRITE 2C/L +LOOP 0 17 CLRLN DROP ( n) MFREE ; I wondered what would happen if I the buffer the size the screen (minus one line) and move it all at once. I have a way to allocate low RAM and release it again very quickly so I don't have to eat the space permanently. I did it with the code below. It reduced the time to 43mS and takes less code space, BUT if I use 80 column mode the buffer size is 1840 bytes. Yikes. It's pretty wasteful even it it is temporary but it does speed up screen I/O when you need scrolling. \ 14 bytes smaller, faster, BUT uses huge malloc buffer \ vdp2vdp byte movement with auto buffer allocation : VCMOVE ( dest src bytes -- ) DUP MALLOC OVER >R DUP >R \ r-- bytes buffer SWAP \ -- dst src buffer cnt VREAD \ -- dest R> \ -- dest buffer SWAP R@ \ -- buffer dest bytes VWRITE R> MFREE ; : SCROLL VTOP @ DUP C/L@ + C/SCR @ OVER - ( dst src bytes) VCMOVE 0 17 CLRLN ; \ 43 mS All that to say I will leave the big buffer in place. The dirty little secret is that at any time, I can use a fast typing routine that writes to the screen at machine speeds, but does not automatically scroll. This gives me a back door for fast screen writes. 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 20, 2019 Author Share Posted November 20, 2019 (edited) In Search of a Search So one of the things an editor needs is a way to find text in a big file. Forth 2012 has some new words added to the optional string wordset. One is called SEARCH. https://forth-standard.org/standard/string/SEARCH How convenient. I took a run at what it would take to make a SEARCH word for my little system that would be flexible enough for use in an editor. As is trendy in modern Forth the new SEARCH word uses stack strings that exist as a pair (address,length). This allows you to process strings of any length upto the biggest integer your Forth can handle. So for 9900 64K bytes. The standard word to compare two strings in ANS/ISO Forth is: COMPARE ( addr1 n1 addr2 n2 -- -1|0|1 ) It return 0 if the strings match, -1 if addr1<addr2 and 1 if addr1>addr2. I have library file for COMPARE IN Forth, that is code published by a late pioneer of Forth named Neil Baud (also know by the pseudonym Wil Baden) \ Neil Baud's toolbelt: COMPARE in Forth : COMPARE ( a1 n1 a2 n2 -- -1|0|1 ) ROT 2DUP - >R ( a1 a2 n2 n1)( R: n2-n1) MIN ( a1 a2 n3) BOUNDS ?DO ( a1) COUNT I C@ - ( a1 diff) DUP IF ( there's a difference ) NIP 0< 1 OR ( -1|1) UNLOOP R> DROP EXIT ( a1 diff) THEN DROP ( a1) LOOP DROP ( ) R> DUP IF 0> 1 OR THEN \ 2's complement arith. ; \ 30 BYTES This works but can be a little slow. CAMEL Forth's kernel has a string comparison word called S= written in Assembler which is fast. It was originally used lookup strings in for the interpreter/compiler. I don't use it for that purpose now, but I kept it in the kernel for just such an occasion. S= needs the follow arguments. ( Addr1 addr2 cnt) and it returns the same argument as COMPARE. {this will become significant in a moment} Here we can demonstrate the magic of concatenative programming. If we look at COMPARE in the first two lines we see. ROT 2DUP - >R MIN The first line rotates n1 to the top of the stack. 2DUP gives us a copy of n2 and n1. They are subtracted and the difference is saved on the return stack for later use. The stack now contains ( addr1 addr2 n2 n1 ) MIN throws away the bigger value of n2 and n1 leaving us with (addr1 addr2 n ) on the stack... exactly what we need for S=. So my fast compare becomes: : COMPARE ( addr1 n1 addr2 n2 -- -1|0|1 ) ROT MIN S= ; This is much simpler and smaller than writing the entire routine over again in Assembler and will be almost as quick. Once I had a fast compare SEARCH became pretty straight forward. I took the simple route and create a temp buffer for the string we are searching for. Seems to work as designed. : COMPARE ( a1 n1 a2 n2 -- -1|0|1 ) 1+ ROT MIN S= ; \ S= is CAMEL Forth primitive : 2OVER ( d d2 -- d d2 d) 3 PICK 3 PICK ; : SAMELEN ( addr1 u1 addr2 u2 -- addr1 u1 addr2 u1) DROP OVER ; 0 VALUE SBUFF \ temp buffer for search string : (SRCH) ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3) SBUFF PLACE BEGIN DUP WHILE SBUFF COUNT 2OVER SAMELEN COMPARE 0= IF EXIT THEN ( jump to ';') 1 /STRING REPEAT ; HEX : SEARCH ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag ) 100 DUP >R MALLOC TO SBUFF (SRCH) DUP 0> R> MFREE 0 TO SBUFF ; Edited November 20, 2019 by TheBF Added flag to SEARCH per standard 1 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.