+Lee Stewart Posted November 7, 2021 Share Posted November 7, 2021 2 hours ago, RXB said: Yea guys I just think reading the CRU lines 6 to 14 would be faster as you just look for a non zero value for a key pressed. No key pressed would mean those 4 bits are zero, keypress would be a value depending on that value. Actually (and counterintuitively!), the CRU bit for a pressed key is 0, so, for your logic to work, you would need to INVert the result returned by the STCR Assembly code instruction. ...lee 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 7, 2021 Author Share Posted November 7, 2021 Thanks guys. I will do some work in this area. I actually coded up the Thierry code a long time back to measure it. It takes 9 ticks. So that's 5 times faster. I never used it. At that time I was on the hairy edge of exceeding my 8K program size and so I didn't go any further with it. I think I can figure out how to patch a new KEY routine into the system when the multi-tasker loads. This idea would make things more efficient for sure. 1 Quote Link to comment Share on other sites More sharing options...
RXB Posted November 7, 2021 Share Posted November 7, 2021 (edited) 4 hours ago, Lee Stewart said: Actually (and counterintuitively!), the CRU bit for a pressed key is 0, so, for your logic to work, you would need to INVert the result returned by the STCR Assembly code instruction. ...lee Are you saying all CRU bits are set to one unless a key is pressed and that bit is zero? This would be the opposite of every keyboard switch on planet. As far as I know it has always been zero unless that switch is on, which is the opposite of what you stated above? I think Editor Assembler Page 156 (TB) disagrees with this as it reads in "Application Notes:" The CRU bit is transferred with no modification to the STATUS BYTE thus I think there is confusion between status and actual bit values. Edited November 7, 2021 by RXB Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 7, 2021 Author Share Posted November 7, 2021 Before I get to my key problems I had this crazy idea this morning since I have now some fluency with the graphics and multi-tasking functions. This might make a neat screen saver. Spoiler \ MYSTERIOUS EYES INCLUDE DSK1.TOOLS \ DEBUG ONLY INCLUDE DSK1.DATABYTE INCLUDE DSK1.MARKER INCLUDE DSK1.GRAFIX INCLUDE DSK1.RANDOM INCLUDE DSK1.DIRSPRIT INCLUDE DSK1.MTASK99 \ chopped into 4 pieces for smooth multi-tasking : CHARDEF4 ( data[] ascii# -- ) >R ( hold ascii# on Rstack like a local variable) DUP R@ CHARDEF PAUSE 8 + DUP R@ 1+ CHARDEF PAUSE 8 + DUP R@ 2+ CHARDEF PAUSE 8 + R> 3 + CHARDEF PAUSE ; \ **************************************** \ * Sprite Patterns \ **************************************** HEX CREATE EYELIDS DATA 030C,1020,4040,8080 \ 0 Wide open DATA 8080,4040,2010,0C03 \ DATA C030,0804,0202,0101 \ DATA 0101,0202,0408,30C0 \ DATA 030F,1F3F,4040,8080 \ DATA 8080,4040,2010,0C03 \ DATA C0F0,F8FC,0202,0101 \ DATA 0101,0202,0408,30C0 \ DATA 030F,1F3F,7F7F,8080 \ DATA 8080,4040,2010,0C03 \ DATA C0F0,F8FC,FEFE,0101 \ DATA 0101,0202,0408,30C0 \ DATA 030F,1F3F,7F7F,FFFF \ DATA 8080,4040,2010,0C03 \ DATA C0F0,F8FC,FEFE,FFFF \ DATA 0101,0202,0408,30C0 \ DATA 030F,1F3F,7F7F,FFFF \ DATA FFFF,4040,2010,0C03 \ DATA C0F0,F8FC,FEFE,FFFF \ DATA FFFF,0202,0408,30C0 \ DATA 030F,1F3F,7F7F,FFFF \ DATA FFFF,7F7F,2010,0C03 \ DATA C0F0,F8FC,FEFE,FFFF \ DATA FFFF,FEFE,0408,30C0 \ DATA 030F,1F3F,7F7F,FFFF \ DATA FFFF,7F7F,3F1F,0C03 \ DATA C0F0,F8FC,FEFE,FFFF \ DATA FFFF,FEFE,FCF8,30C0 \ DATA 030F,1F3F,7F7F,FFFF \ DATA FFFF,7F7F,3F1F,0F03 \ DATA C0F0,F8FC,FEFE,FFFF \ DATA FFFF,FEFE,FCF8,F0C0 \ 7 FULLY CLOSED DECIMAL : ]EYELID 32 * EYELIDS + ; CREATE PUPIL HEX DATA 0000,0000,0001,0307 DATA 0707,0301,0000,0000 DATA 0000,0000,00C0,E0F0 DATA F0F0,E0C0,0000,0000 \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ DECIMAL 128 CONSTANT LEFTEYE 132 CONSTANT RIGHTEYE 136 CONSTANT LEFTPUPIL 140 CONSTANT RIGHTPUPIL 144 CONSTANT SCLERA ( the white part of the eye) VARIABLE FATIGUE 12 FATIGUE ! VARIABLE NERVOUS 40 NERVOUS ! : BLINKER FATIGUE @ MS ; : NERVES NERVOUS @ MS ; : CLOSE1 ( char --) 8 0 DO I ]EYELID OVER CHARDEF4 BLINKER LOOP DROP ; : OPEN1 ( char --) 0 7 DO I ]EYELID OVER CHARDEF4 BLINKER -1 +LOOP DROP ; : BLINK1 ( char -- ) DUP CLOSE1 OPEN1 ; : CLOSE2 ( -- ) 8 0 DO I ]EYELID DUP LEFTEYE CHARDEF4 RIGHTEYE CHARDEF4 BLINKER LOOP ; : OPEN2 ( -- ) 0 7 DO I ]EYELID DUP LEFTEYE CHARDEF4 RIGHTEYE CHARDEF4 BLINKER -1 +LOOP ; : BLINK2 CLOSE2 OPEN2 ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ CREATE EYE-XY 0 , 0 , EYE-XY CONSTANT EROW EYE-XY 2+ CONSTANT ECOL : PIX.COL ( -- n) ECOL @ 8* ; : PIX.ROW ( -- n) EROW @ 8* 1- ; : DEF.CHARS 0 ]EYELID LEFTEYE CHARDEF4 0 ]EYELID RIGHTEYE CHARDEF4 PUPIL LEFTPUPIL CHARDEF4 PUPIL RIGHTPUPIL CHARDEF4 7 ]EYELID SCLERA CHARDEF4 ( define a white circle in 4 chars ) SCLERA SET# 16 1 COLOR ( make it white) 2 MAGNIFY ; : .EYELIDS ( char colr x y sp# -- ) 128 2 PIX.COL PIX.ROW 0 SPRITE \ left eye 132 2 PIX.COL 32 + PIX.ROW 1 SPRITE \ left right ; : .PUPILS 136 2 PIX.COL PIX.ROW 2 SPRITE \ left pupil 140 2 PIX.COL 32 + PIX.ROW 3 SPRITE \ right pupil ; : .SCLERA ( col row --) 2DUP AT-XY 144 EMIT 146 EMIT 1+ AT-XY 145 EMIT 147 EMIT ; : .2SCLERA ( --) VROW 2@ 2>R \ save cursor position EYE-XY 2@ .SCLERA EYE-XY 2@ SWAP 4 + SWAP .SCLERA 2R> AT-XY ; \ restore : .EYES ( col row -- ) EYE-XY 2! .2SCLERA .EYELIDS .PUPILS ; : ?GAZE ( n -- n ) DUP 5 -4 WITHIN ABORT" Ouch!" ; : SP.X+! ( n spr# --) ?GAZE SP.X DUP>R VC@ + R> VC! ; : SP.Y+! ( n spr# --) ?GAZE SP.Y DUP>R VC@ + R> VC! ; : HORZ ( offset -- ) DUP 2 SP.X VC! 32 + 3 SP.X VC! ; : VERT ( height -- ) DUP 2 SP.Y VC! 3 SP.Y VC! ; : CENTER ( -- ) PIX.COL HORZ PIX.ROW VERT ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ TASKS : BLINKING ( -- ) BEGIN 4000 RND 250 + MS BLINK2 AGAIN ; : LEFT/RIGHT BEGIN 3000 RND 250 + MS PIX.COL 8 RND 4 - + HORZ AGAIN ; : UP/DOWN BEGIN 4000 RND 500 + MS PIX.COL 8 RND 4 - + VERT AGAIN ; CREATE JOB1 USIZE ALLOT JOB1 FORK CREATE JOB2 USIZE ALLOT JOB2 FORK CREATE JOB3 USIZE ALLOT JOB3 FORK ' BLINKING JOB1 ASSIGN ' LEFT/RIGHT JOB2 ASSIGN ' UP/DOWN JOB3 ASSIGN : GO PAGE DEF.CHARS 10 10 .EYES 0 0 AT-XY JOB1 WAKE JOB2 WAKE JOB3 WAKE ; EYES.mp4 1 Quote Link to comment Share on other sites More sharing options...
+mizapf Posted November 7, 2021 Share Posted November 7, 2021 1 hour ago, RXB said: Are you saying all CRU bits are set to one unless a key is pressed and that bit is zero? This would be the opposite of every keyboard switch on planet. The keys close contact to 0V (from the 74LS138 selector), so the bit value is exactly the logical level. 1 = open, 0 = closed. Closing to 0V (GND) is a very common concept. 2 Quote Link to comment Share on other sites More sharing options...
RXB Posted November 7, 2021 Share Posted November 7, 2021 (edited) 40 minutes ago, mizapf said: The keys close contact to 0V (from the 74LS138 selector), so the bit value is exactly the logical level. 1 = open, 0 = closed. Closing to 0V (GND) is a very common concept. Hmmm last I checked in electronics: Open means OFF or zero for no voltage passed. Closed means ON or one for votage is passed. Unless bit values are reversed so 1 is off and 0 is on, but I have never seen that. Closed, Open, and Short Circuits - dummies Ok so you are saying Lee is right, but since when has 1 in the return of the CRU bit meant off? Looking at charts of CRU they indicate 1 for activation and you are saying the opposite that activation is 0? How come the CRU bit value is 1 but you say 0? Edited November 7, 2021 by RXB Quote Link to comment Share on other sites More sharing options...
+mizapf Posted November 7, 2021 Share Posted November 7, 2021 If you have a look at common microcontroller I/O port usage, the usual way is to pull up the input via a resistor, and then use a switch or key and let it close to 0, thus pulling down the input. This is exactly what is done with the TI keyboard: Pressing a key closes the path to 0 (which is selected by the 74LS138, which itself is controlled by three CRU bits). So the 1 (open) and 0 (closed) of the key is fed into the 9901, and this is what you read by STCR or TB. 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted November 7, 2021 Share Posted November 7, 2021 1 hour ago, RXB said: Are you saying all CRU bits are set to one unless a key is pressed and that bit is zero? This would be the opposite of every keyboard switch on planet. As far as I know it has always been zero unless that switch is on, which is the opposite of what you stated above? I think Editor Assembler Page 156 (TB) disagrees with this as it reads in "Application Notes:" The CRU bit is transferred with no modification to the STATUS BYTE thus I think there is confusion between status and actual bit values. 11 minutes ago, RXB said: Hmmm last I checked in electronics: Open means OFF or zero for no voltage passed. Closed means ON or one for votage is passed. Unless bit values are reversed so 1 is off and 0 is on, but I have never seen that. Closed, Open, and Short Circuits - dummies Your protestations to the contrary notwithstanding, the fact remains that CRU bits for the keyboard are 1 = key up 0 = key down (pressed) The E/A page you reference says nothing about the values of keyboard CRU bits. It is talking about CRU bits in general. It says that CRU bits are transferred unchanged. The bit values can be 0 or 1. You have apparently never read the keyboard CRU bits with your own Assembly code. If you look at the code for the console’s KSCAN, you will see (at address >0344) SETO R4 INVERT FOLLOWS STCR R4,8 STORE KBD OUTPUTS INV R4 MAKE ANY STROBE A 1 MOV R1,R1 LAST KBD STROBE JNE C354 NO MOVB R4,R7 SAVE BITS FROM KBD ANDI R4,>0F00 Notice the INV instruction after the keyboard CRU bits are read and the comment (from TI programmers) to its right. ...lee 3 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 7, 2021 Author Share Posted November 7, 2021 Ok I cleaned up the code. There was a lot of unused cruft in there. I also made an E/A5 program so there a little screen saver for everyone. For some strange reason I find to funny to have these eyes looking around from inside my computer. Things I learned: You must run INIT-MULTI in your startup code if you want to run the multi-tasker. DUH! It runs automatically when you compile the multi-tasker. I just write the stuff. I don't know how to USE it. (See GO in the code) This version uses only 2 extra tasks and the console task handles the up/down eye motion. Spoiler \ MYSTERIOUS EYES \ INCLUDE DSK1.TOOLS \ DEBUG ONLY INCLUDE DSK1.DATABYTE INCLUDE DSK1.MARKER INCLUDE DSK1.GRAFIX INCLUDE DSK1.RANDOM INCLUDE DSK1.DIRSPRIT INCLUDE DSK1.MTASK99 DECIMAL : CHARDEF4 ( data[] ascii# -- ) PAUSE ]PDT 32 VWRITE ; \ **************************************** \ * Sprite Patterns \ **************************************** HEX CREATE EYELIDS DATA 030C,1020,4040,8080 \ 0 Wide open DATA 8080,4040,2010,0C03 DATA C030,0804,0202,0101 DATA 0101,0202,0408,30C0 DATA 030F,1F3F,4040,8080 DATA 8080,4040,2010,0C03 DATA C0F0,F8FC,0202,0101 DATA 0101,0202,0408,30C0 DATA 030F,1F3F,7F7F,8080 DATA 8080,4040,2010,0C03 DATA C0F0,F8FC,FEFE,0101 DATA 0101,0202,0408,30C0 DATA 030F,1F3F,7F7F,FFFF DATA 8080,4040,2010,0C03 DATA C0F0,F8FC,FEFE,FFFF DATA 0101,0202,0408,30C0 DATA 030F,1F3F,7F7F,FFFF DATA FFFF,4040,2010,0C03 DATA C0F0,F8FC,FEFE,FFFF DATA FFFF,0202,0408,30C0 DATA 030F,1F3F,7F7F,FFFF DATA FFFF,7F7F,2010,0C03 DATA C0F0,F8FC,FEFE,FFFF DATA FFFF,FEFE,0408,30C0 DATA 030F,1F3F,7F7F,FFFF DATA FFFF,7F7F,3F1F,0C03 DATA C0F0,F8FC,FEFE,FFFF DATA FFFF,FEFE,FCF8,30C0 DATA 030F,1F3F,7F7F,FFFF DATA FFFF,7F7F,3F1F,0F03 DATA C0F0,F8FC,FEFE,FFFF DATA FFFF,FEFE,FCF8,F0C0 \ 7 FULLY CLOSED DECIMAL : ]EYELID 32 * EYELIDS + ; CREATE PUPIL HEX DATA 0000,0000,0001,0307 DATA 0707,0301,0000,0000 DATA 0000,0000,00C0,E0F0 DATA F0F0,E0C0,0000,0000 \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ DECIMAL 128 CONSTANT LEFTEYE 132 CONSTANT RIGHTEYE 136 CONSTANT LEFTPUPIL 140 CONSTANT RIGHTPUPIL 144 CONSTANT SCLERA ( the white part of the eye) VARIABLE FATIGUE 18 FATIGUE ! VARIABLE CALM 90 CALM ! : BLINKER FATIGUE @ MS ; : CLOSE2 ( -- ) 8 0 DO I ]EYELID DUP LEFTEYE CHARDEF4 RIGHTEYE CHARDEF4 BLINKER LOOP ; : OPEN2 ( -- ) 0 7 DO I ]EYELID DUP LEFTEYE CHARDEF4 RIGHTEYE CHARDEF4 BLINKER -1 +LOOP ; : BLINK2 CLOSE2 OPEN2 ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ CREATE EYE-XY 0 , 0 , EYE-XY CONSTANT EROW EYE-XY 2+ CONSTANT ECOL : PIX.COL ( -- n) ECOL @ 8* ; : PIX.ROW ( -- n) EROW @ 8* 1- ; : DEF.CHARS 0 ]EYELID LEFTEYE CHARDEF4 0 ]EYELID RIGHTEYE CHARDEF4 PUPIL LEFTPUPIL CHARDEF4 PUPIL RIGHTPUPIL CHARDEF4 7 ]EYELID SCLERA CHARDEF4 ( define a white circle in 4 chars ) SCLERA SET# 16 1 COLOR ( make it white) 2 MAGNIFY ; : .EYELIDS ( char colr x y sp# -- ) CLOSE2 128 2 PIX.COL PIX.ROW 0 SPRITE \ left eye 132 2 PIX.COL 32 + PIX.ROW 1 SPRITE \ left right ; : .PUPILS ( char colr x y sp# -- ) 136 5 PIX.COL PIX.ROW 2 SPRITE \ left pupil 140 5 PIX.COL 32 + PIX.ROW 3 SPRITE \ right pupil ; : .SCLERA ( col row --) 2DUP AT-XY 144 EMIT 146 EMIT 1+ AT-XY 145 EMIT 147 EMIT ; : .2SCLERA ( --) VROW 2@ 2>R \ save cursor position EYE-XY 2@ 2DUP .SCLERA SWAP 4 + SWAP .SCLERA 2R> AT-XY ; \ restore : .EYES ( col row -- ) EYE-XY 2! .2SCLERA .EYELIDS .PUPILS ; : HORZ ( offset -- ) DUP 2 SP.X VC! 32 + 3 SP.X VC! ; : VERT ( height -- ) DUP 2 SP.Y VC! 3 SP.Y VC! ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ TASKS : BLINKING ( -- ) BEGIN 4000 RND FATIGUE @ + MS BLINK2 AGAIN ; : LEFT/RIGHT BEGIN 2000 RND CALM @ + MS PIX.COL 8 RND 4 - + HORZ AGAIN ; : UP/DOWN BEGIN 3000 RND CALM @ + MS PIX.COL 8 RND 5 - + VERT ?TERMINAL ABORT" Forth" AGAIN ; CREATE JOB1 USIZE ALLOT CREATE JOB2 USIZE ALLOT HEX 83D6 CONSTANT SCR-TIMER DECIMAL : GO GRAPHICS DEF.CHARS 10 10 .EYES 0 0 AT-XY INIT-MULTI JOB1 FORK JOB2 FORK ['] BLINKING JOB1 ASSIGN ['] LEFT/RIGHT JOB2 ASSIGN JOB1 RESTART JOB2 RESTART SCR-TIMER ON MULTI UP/DOWN ; HERE ORGDP ! LATEST @ ORGLAST ! INCLUDE DSK1.SAVESYS ' GO SAVESYS DSK5.EYES EYES.zip 4 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 9, 2021 Author Share Posted November 9, 2021 Backing Thinkwards Just read this article about an problem solving methodology that I had never heard of. https://newsletter.butwhatfor.com/p/invert-always-invert-avoid-failure The article describes solving problems by actively searching for ways that will fail. I never thought of it quite so brutally but it reminds of something I said once at a Forth conference and Elizabeth Rather and a few others looked at me like I was out of my mind. I said: "Forth let's me make more mistakes per minute" By that I meant that by cutting programs into tiny pieces that could be tested in seconds interactively, I could make a lot of mistakes in a short time and therefore could find the best solution faster. Looks like I didn't invent the concept. 3 Quote Link to comment Share on other sites More sharing options...
GDMike Posted November 9, 2021 Share Posted November 9, 2021 (edited) Absolutely. I love the ability for flexible scenario calculating. Sometimes I find myself placing too much information into my code because I assume I know some of the answer and it's results, and I have to slow down and let forth do the assuming. How do I know that? Because my word is like 10 or more lines and growing without creating another word and my comments say, this is already known...lol Edited November 9, 2021 by GDMike 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 9, 2021 Author Share Posted November 9, 2021 Exactly. 10 or more lines is normal for other languages but can get hard to read in Forth. I read that after Chuck Moore saw how other people wrote Forth code he said something like "Maybe not everybody should use Forth" :) I got the sense that he was shocked by what he saw. Oh well us mere mortals will just have to carry on. 2 1 Quote Link to comment Share on other sites More sharing options...
GDMike Posted November 9, 2021 Share Posted November 9, 2021 I'm good in small steps anyway and prefer it, but not so small as assembly makes it...at that point I'm like, do I really have to clear this register and the next and the one sitting next to that one.. uhhhahrhgg!!! 1 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 11, 2021 Author Share Posted November 11, 2021 Over on Reddit r/Forth a bunch of people found a game from Byte Magazine written in Forth in 1982. Byte Magazine Volume 07 Number 12 - Game Plan 1982 : Free Download, Borrow, and Streaming : Internet Archive It was for some Forth that ran on 6502. Rick Carlino translated it into something the runs on GForth. It wasn't too hard to make ANS GForth code run on ANS Camel Forth but it is still kind of ugly. Actually I can tell that the original author was still getting his head around Forth because the factoring is not good. Anyway I put it up here and will see what I can do to make it into something fun for TI-99. CAMEL99-V2/CosmicConquest at master · bfox9900/CAMEL99-V2 · GitHub 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 15, 2021 Author Share Posted November 15, 2021 Well trying to improve 39 year old software is rather time consuming... But I have something that is getting closer to playable. Some people have got Cosmic conquest running on 6502 emulators but it has been a challenge from what I am told. We know it ran on a Fig Forth dialect but we don't which one. Nobody seems to know how to interpret the graphics definitions in the program so I just punted and made my own. I took my first look at the code last Monday. When I regained consciousness... I decided it needed some Forthifying cuz it looked a lot like BASIC written in Forth syntax. That works fine in BASIC but it makes Forth harder to read and Forth doesn't need any help in that department. Here is a sample: : BUY ( purchasing of ships at planet) BUY-V @ 0= IF ( it's ok to buy) 5 BUY-V ! ( stop continous buying) RANDOM1 5 / XY@ INFO1 C@ 10 / + 1+ DUP TEMP1 ! 10 0 VHTAB ." COST PER SHIP = " 2 .R 12 0 VHTAB ." HOW MANY DO YOU WANT?" INPUT CREDIT @ TEMP1 @ / MIN ( no more than he can afford) DUP 3 F @ + 3 F ! ( update ships in fleet) TEMP1 @ * CREDIT @ SWAP - CREDIT ! ( update credit) 16 1 F C@ 2 F C@ GALAXY C! ( make sure fleet symbol there) ELSE 10 0 VHTAB ." NO SHIPS AVAILABLE" ENDIF ; "F" is the name of an array. Not good form, since "F" is also a valid HEX number. And so on... It actually wants a complete re-write to be a better Forth program but I will settle for band-aids. I still don't have my head around one aspect of the data that manages two fleets for the player but it mostly works now and I can make changes easier now. It is coming in at over 900 lines. The full thing is here with a screen shot. CAMEL99-V2/CosmicConquest at master · bfox9900/CAMEL99-V2 · GitHub Its a very old game and a little boring by today's standards. I want to stay true to the original but I think I have to add some sound effects. I already added beeps and honk. When I finally get there I will build a binary and people can beat it up. COSMIC99-CLIP.mp4 4 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 16, 2021 Author Share Posted November 16, 2021 I had to take my head out of that game for a while. :) I explored the key discussion we had earlier and it started to come back to me that one problem I had before was it took a while for the fast key detection code to clear the last key pressed. I added FLUSHKEY to wait until the mechanism is clear. This code seems to work ok and would only add 140 bytes to the multi-tasking system so it might be worth making it the default. The only caveat is that FLUSHKEY would have to be run before the program starts. I have not yet tried patching this into the main KEY routine in Forth. That's the next part of the job. \ FASTKEY is better for multi-tasking \ KSCAN in the system ROM uses internal delays for debounce. \ It takes 1.2 mS to run even if no key is pressed! \ This slows down cooperative multi-tasking by slowing down \ the context switch time while waiting for a key keypress. NEEDS WORDLIST FROM DSK1.SUPERTOOLS \ Source: \ http://www.unige.ch/medecine/nouspikel/ti99/keyboard.htm#quick%20scan FORTH DEFINITIONS ALSO ASSEMBLER HERE HEX CODE (KEY?) ( -- ?) \ return TRUE if any key pressed TOS PUSH, \ TOS CLR, \ TOS=false R1 CLR, \ Start with column 0 BEGIN, R12 0024 LI, \ R12-address for column selection R1 0003 LDCR, \ Select a column R12 0006 LI, \ R12-address to read rows R2 SETO, \ Make sure all bits are 1 R2 0008 STCR, \ read 8 row values R2 INV, \ pressed keys read as 0 so flip all bits NE IF, \ A key was pressed TOS SETO, \ Set TOS true for Forth NEXT, \ return to Forth ENDIF, R1 0100 AI, \ Next column R1 0600 CI, \ Are we done? EQ UNTIL, NEXT, \ Return to Forth ENDCODE : FLUSHKEY ( -- ) \ make sure no key is pressed BEGIN (KEY?) WHILE REPEAT ; : WAITKEY ( -- ) BEGIN PAUSE \ Essential for Multi-tasking with Console CURS @ \ fetch 2 char cursor (space & _ ) TMR@ 1FFF < IF >< THEN VPUT \ swap cursor bytes & write (KEY?) UNTIL ; \ over-write the old version : KEY ( -- c) WAITKEY KEY ; HERE SWAP - DECIMAL . .( bytes) : TEST1 FLUSHKEY BEGIN KEY EMIT ?TERMINAL UNTIL ; 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 20, 2021 Author Share Posted November 20, 2021 The assembled coding talent in this forum just blows my mind. I was away for a few days and started looking at Time Pilot source code by @retroclouds So wonderful to read it. One of the downsides of working in Forth is the constant need to re-invent the wheel or doing a lot of translating of source code since Forth is unusual. I saw the KONAMI font in the Time Pilot source code and realized I could adapt that pretty quickly with DATABYTE library. So here is how to "borrow" fonts from Assembler projects and use them in Camel99. We don't need the '>' character. A little search and replace fixed it up. Then we just needed a bit of editing to get something that works. In this case we are recording the data in expansion RAM like the original program did. Each block of data is given a name in the Forth dictionary with the CREATE word. At the bottom we use the interpreter to write the data blocks into VDP RAM and then compile a short TEST word to see how it looks. \ Taken from TIME PILOT SOURCE CODE, translated for CAMEL99 FORTH \ *************************************************************** \ * KONAMI Game Font - from Konami's Athletic Land for MSX \ * Letter A-Z \ **************************************************************** INCLUDE DSK1.DATABYTE INCLUDE DSK1.GRAFIX HEX CREATE KONAMI BYTE 00,1C,36,63,63,7F,63,63 \ A BYTE 00,7E,63,63,7E,63,63,7E \ B BYTE 00,3E,63,60,60,60,63,3E \ C BYTE 00,7C,66,63,63,63,66,7C \ D BYTE 00,7F,60,60,7E,60,60,7F \ E BYTE 00,7F,60,60,7E,60,60,60 \ F BYTE 00,3E,63,60,67,63,63,3F \ G BYTE 00,63,63,63,7F,63,63,63 \ H BYTE 00,3C,18,18,18,18,18,3C \ I BYTE 00,1F,06,06,06,06,66,3C \ J BYTE 00,63,66,6C,78,7C,6E,67 \ K BYTE 00,60,60,60,60,60,60,7F \ L BYTE 00,63,77,7F,7F,6B,63,63 \ M BYTE 00,63,73,7B,7F,6F,67,63 \ N BYTE 00,3E,63,63,63,63,63,3E \ O BYTE 00,7E,63,63,63,7E,60,60 \ P BYTE 00,3E,63,63,63,6F,66,3D \ Q BYTE 00,7E,63,63,62,7C,66,63 \ R BYTE 00,3E,63,60,3E,03,63,3E \ S BYTE 00,7E,18,18,18,18,18,18 \ T BYTE 00,63,63,63,63,63,63,3E \ U BYTE 00,63,63,63,63,36,1C,08 \ V BYTE 00,63,63,6B,6B,7F,77,22 \ W BYTE 00,63,76,3C,1C,1E,37,63 \ X BYTE 00,66,66,7E,3C,18,18,18 \ Y BYTE 00,7F,07,0E,1C,38,70,7F \ Z \ *************************************************************** \ * KONAMI Game Font - from Konami's Athletic Land for MSX \ * Digits 0-9, SPACE and HYPHEN \ *************************************************************** CREATE KONAMI# BYTE 00,1C,22,63,63,63,22,1C \ 0 BYTE 00,18,38,18,18,18,18,7E \ 1 BYTE 00,3E,63,03,0E,3C,70,7F \ 2 BYTE 00,3E,63,03,0E,03,63,3E \ 3 BYTE 00,0E,1E,36,66,66,7F,06 \ 4 BYTE 00,7F,60,7E,63,03,63,3E \ 5 BYTE 00,3E,63,60,7E,63,63,3E \ 6 BYTE 00,7F,63,06,0C,18,18,18 \ 7 BYTE 00,3E,63,63,3E,63,63,3E \ 8 BYTE 00,3E,63,63,3F,03,63,3E \ 9 BYTE 00,00,00,00,00,00,00,00 \ SPACE BYTE 00,00,00,7E,00,00,00,00 \ - DECIMAL KONAMI CHAR A ]PDT 26 8* VWRITE KONAMI# CHAR 0 ]PDT 12 8* VWRITE : TEST PAGE ." WE HAVE KONAMI FONT" CR CR ." FOR CAMEL99 FORTH" KEY DROP ; Alternatively after loading the code above, we could save this VDP RAM data as font file and load it on program start. INCLUDE DSK1.LOADSAVE S" DSK3.KONAMI" SAVE-FONT 4 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 25, 2021 Author Share Posted November 25, 2021 (edited) Over on the "Substantial Programs in Forth" topic, we were talking about a demo program suggested by @neglectoru The demo program needed to deal with time and it made me realize that I didn't have a time module in my library files. So here is one that gives some degree of versatility. I have opted to use a the stack order: ( -- sec mins hrs ) because it's faster to convert back and forth to seconds. However there are also two words that let you change that order to ( -- hrs mins sec) and another to switch back so the bases are covered. In our discussion over in the other topic @neglectoru was struggling with the how in the heck you could manage all those stack elements for dates and times in Forth. It is true that variables can make some things much simpler but in this case I think factoring allowed us to do the job without too much mental strain. I opted to not pull-in the entire doubles library and just used the CORE Forth words in the kernel plus D= and DU< defined here. I have a DATE library that is borrowed from the work of the late great Neil Baud (aka Wil Baden) in the second spoiler. It lets us calculate the "century day" so we can compare dates for before and after and also from the century-day we can compute the day of the week. With these two little files we could continue to flesh out the calendar application. TIME.FTH Spoiler \ TIME.FTH time utilities for Camel99 Forth Nov 24 2012 Brian Fox \ 32 bit integer we can manage up to 2^32 seconds, or 119304 hrs. \ INCLUDE DSK1.TOOLS \ debugging DECIMAL : HRS>MINS ( n -- d) 3600 UM* ; : MINS>SECS ( n -- d) 60 UM* ; \ stackcrobatics for 3 items (hours,minutes,seconds) : >SSMMHH ( h m s -- s m h) SWAP ROT ; : >HHMMSS ( s m h -- h m s) -ROT SWAP ; : TIME>D ( s m h -- d) \ convert time format to DOUBLE (32bit int) HRS>MINS 2>R \ push double to rstack MINS>SECS SWAP M+ \ add secs (single) to mins (double) with mixed + 2R> D+ ; \ add hrs to sub-total : D>TIME ( d -- s m h ) \ convert DOUBLE to time 3600 UM/MOD ( -- rem hrs) >R 60 /MOD ( -- secs mins) R> ; ( -- secs mins hrs) \ Concept from Starting Forth, Brodie. Would have never thought of this :) : SEXTAL 6 BASE ! ; : <:> [CHAR] : HOLD ; : <.> [CHAR] . HOLD ; : ##: # SEXTAL # DECIMAL <:> ; : .TIME ( d -- ) \ expects double int as time in seconds on stack BASE @ >R <# ##: ##: # # #> TYPE R> BASE ! ; : DU< ( d d -- ?) ROT U> IF 2DROP TRUE ELSE U< THEN ; : D= ( d d -- ?) ROT = -ROT = AND ; : REDUCE2 ( s m h s m h -- d1 d2) \ convert 2 times into 2 doubles TIME>D 2>R \ convert top time and push TIME>D 2R> \ convert and pop ; : ISBEFORE ( s m h s m h -- ?) REDUCE2 DU< ; \ is 1st time before 2nd time : ISAFTER ( s m h s m h -- ?) REDUCE2 2SWAP DU< ; \ is 1st time after 2nd time : SAMETIME ( s m h s m h -- ?) REDUCE2 D= ; \ are both times the same DATE.FTH Spoiler \ DATES.FTH for Camel99 Forth 2019 Fox \ changed to create strings for more flexibility \ INCLUDE DSK1.TOOLS DECIMAL \ "This is an algorithm I've carried with me for 35 years, \ originally in Assembler and Fortran II." \ It counts the number of days from March 1, 1900." \ Wil Baden R.I.P : UNDER+ ( a b c -- a+c b ) ROT + SWAP ; \ ***************************************************** \ **WARNING** only good until 2078 on 16 bit machine ** \ ***************************************************** : CDAY ( dd mm yyyy -- century_day ) -3 UNDER+ OVER 0< IF 12 UNDER+ 1- THEN 1900 - 1461 4 */ SWAP 306 * 5 + 10 / + + ; : DOW ( cday -- day_of_week ) 2 + 7 MOD 1+ ; ( 7 is Sunday) I also have a very old file I made for HsForth, for date printing in different dates in misc. formats so let's recycle that. It used to be together with DATES.FTH but in a small system let's keep them separate. Note: I finally learned how to make these sequential string arrays work on 9900. I had to add ALIGNED to NTH$ because of course S, does an ALIGNED after it compiles a string into memory to keep on even address boundaries. DATEFORM.FTH Spoiler \ DATEFORM.FTH date formatting words 02MAR91 FOX \ Ported to Camel99 Forth Nov 24 2021 DECIMAL \ compact string array. Uses count byte as link to next string. : NTH$ ( $array n -- address len ) 0 ?DO COUNT + ALIGNED LOOP COUNT ; CREATE MONTHS S" " S, S" Jan" S, S" Feb" S, S" Mar" S, S" Apr" S, S" May" S, S" Jun" S, S" Jul" S, S" Aug" S, S" Sep" S, S" Oct" S, S" Nov" S, S" Dec" S, S" " S, : ## BASE@ >R 0 <# # # #> TYPE R> BASE ! ; : #### BASE@ >R 0 <# # # # # #> TYPE R> BASE ! ; : ]MONTH ( n -- addr len) DUP 13 1 WITHIN ABORT" Bad month#" MONTHS SWAP NTH$ ; : M/D/Y ( dd mm yyyy -- ) >R ## ." /" ## ." /" R> #### ; : Y-M-D ( dd mm yyyy -- ) #### ." -" ## ." -" ## ; : D.M.Y ( dd mm yyyy -- ) >R SWAP ## ." ." ## ." ." R> #### ; : USADATE ( dd mm yyyy -- ) >R ]MONTH TYPE SPACE ## ." ," R> #### ; : FORTH-DATE ( d,m,y,-- ) >R SWAP ## ]MONTH TYPE R> ## ; Edited November 25, 2021 by TheBF BUGS fixed in ISAFTER, ISBEFORE 4 Quote Link to comment Share on other sites More sharing options...
neglectoru Posted November 25, 2021 Share Posted November 25, 2021 I won't pretend to understand the day of week magic, but I think it would be magical in any language. This is neat library! I hope I motivated something useful. 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 25, 2021 Author Share Posted November 25, 2021 1 minute ago, neglectoru said: I won't pretend to understand the day of week magic, but I think it would be magical in any language. This is neat library! I hope I motivated something useful. Yes you did. But... I just discovered the century day is giving me the wrong number! And I cannot find the original site where I saw that code. I am now trying to find information on how to calculate the number of days from any date. What a hobby! Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 25, 2021 Author Share Posted November 25, 2021 So testing seems to be important in software. ? I had never test Neils' century day program against another computation and either I copied it wrong (most likely) or it is not correct. I had posted a Rossetta code solution using this so I have to revisit that and correct it. The other solution in Forth uses Zeller's congruence and seems to be correct so that's my go to method for now. Here is the new DATEFORM.FTH library. I put it all in one file. Spoiler \ DATEFORM.FTH date formatting words 02MAR91 FOX \ Ported to Camel99 Forth Nov 24 2021 DECIMAL \ From Rosseta Code \ Zeller's Congruence for Julian Calendar. : ZELLER ( m -- days since march 1 ) 9 + 12 MOD 1- 26 10 */ 3 + ; : WEEKDAY ( d m y -- 0..6 ) \ Monday..Sunday OVER 3 < IF 1- THEN DUP 4 / OVER 100 / - OVER 400 / + + SWAP ZELLER + + 1+ 7 MOD ; \ compact string array. Uses count byte as link to next string. : NTH$ ( $array n -- address len ) 0 DO COUNT + ALIGNED LOOP COUNT ; CREATE MONTHS S" " S, S" Jan" S, S" Feb" S, S" Mar" S, S" Apr" S, S" May" S, S" Jun" S, S" Jul" S, S" Aug" S, S" Sep" S, S" Oct" S, S" Nov" S, S" Dec" S, 0 , : ]MONTH ( n -- addr len) DUP 13 1 WITHIN ABORT" Bad month#" MONTHS SWAP NTH$ ; CREATE DAYS S" " S, S" Monday" S, S" Tuesday" S, S" Wednesday" S, S" Thursday" S, S" Friday" S, S" Saturday" S, S" Sunday" S, 0 , : ]DAY ( n --) DAYS SWAP 1+ DUP 7 1 WITHIN ABORT" Bad day#" NTH$ ; : ## BASE@ >R 0 <# # # #> TYPE R> BASE ! ; : #### BASE@ >R 0 <# # # # # #> TYPE R> BASE ! ; : 3DUP 2 PICK 2 PICK 2 PICK ; : .M/D/Y ( dd mm yyyy -- ) >R ## ." /" ## ." /" R> #### ; : .Y-M-D ( dd mm yyyy -- ) #### ." -" ## ." -" ## ; : .D.M.Y ( dd mm yyyy -- ) >R SWAP ## ." ." ## ." ." R> #### ; : .USADATE ( dd mm yyyy -- ) >R ]MONTH TYPE SPACE ## ." , " R> #### ; : .FORTH-DATE ( dd mm yyyy -- ) >R SWAP ## ]MONTH TYPE R> ## ; : .LONG-DATE ( dd mm yyyy -- ) 3DUP WEEKDAY ]DAY TYPE ." , " >R ]MONTH TYPE SPACE ## ." , " R> . ; I had no idea date manipulation was so complicated. 4 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 26, 2021 Author Share Posted November 26, 2021 I spent some time reviewing files for a Github refresh and found this "THEMATRIX" demo screen saver. It also is a good demo of how to spawn tasks in low RAM at startup time so you don't take program space the task memory. I think it looks better now and the screen doesn't timeout now (duh!) so I made it into a binary program and it could be a cute screen saver. Spoiler \ THE MATRIX Multi-tasking demonstration Brian Fox 2021 \ NEEDS DUMP FROM DSK1.TOOLS \ DEBUG NEEDS MARKER FROM DSK1.MARKER NEEDS MALLOC FROM DSK1.MALLOC NEEDS RND FROM DSK1.RANDOM NEEDS COLOR FROM DSK1.GRAFIX NEEDS SPRITE FROM DSK1.DIRSPRIT NEEDS FORK FROM DSK1.MTASK99 : HEX#, ( addr len --) \ can be used for longstrings (128 bytes) BASE @ >R \ save radix HEX \ we are converting hex numbers in the string BEGIN DUP WHILE \ while len<>0 2DUP DROP 4 \ get 4 digits from left end of string NUMBER? ABORT" Bad number" \ convert string to number , \ compile the integer into memory 4 /STRING \ cut 4 digits off left side of string REPEAT 2DROP R> BASE ! \ restore radix ; CREATE Japanese DECIMAL S" 007E087E08300000" HEX#, S" 007E020202027E00" HEX#, S" 0044442404043800" HEX#, S" 0000600464087000" HEX#, S" 0004081030501000" HEX#, S" 0028282828284400" HEX#, S" 0000107C107C1000" HEX#, S" 003C448404041800" HEX#, S" 003C000000007E00" HEX#, S" 003E020214080400" HEX#, S" 0004040404043800" HEX#, S" 0042424242023C00" HEX#, S" 007C107C100C0000" HEX#, S" 007C007C007C0000" HEX#, S" 007C007C04380000" HEX#, S" 007C44A404380800" HEX#, S" 007E020438448000" HEX#, S" 0020203824202000" HEX#, S" 00107C1424480000" HEX#, S" 00087C0808300000" HEX#, S" 00407C4040403C00" HEX#, S" 00007C007C106000" HEX#, S" 00287C2808301400" HEX#, S" 0060600404047800" HEX#, S" 0054540404381400" HEX#, S" 007C04281028C400" HEX#, S" 007C040404043800" HEX#, S" 0000107C04043800" HEX#, S" 007C101010107C00" HEX#, S" 00207C2420202000" HEX#, S" 00107C0438540000" HEX#, \ : .JAPAN CR 159 128 DO I EMIT LOOP ; .JAPAN \ : .JAPAN2 CR 207 176 DO I EMIT LOOP ; .JAPAN2 176 128 - CONSTANT WHITECHAR ( changes green character to white) : >WHITE ( greenchar -- whitechar) WHITECHAR + ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ : CLIP ROT MIN MAX ; : RNDCHAR ( -- c) 30 RND 128 + ; \ returns green charset only : RNDX 32 RND ; \ 31 CLIP ; : RNDLEN 19 RND 4 + ; : VROW++ ( -- ) VROW DUP @ 1+ 23 MIN SWAP ! ; : FALLING ( length col row -- ) AT-XY ( len ) 0 ?DO PAUSE RNDCHAR VPUT VROW++ RNDCHAR >WHITE VPUT 60 RND 10 + MS LOOP ; \ \\\\\\\\\\\\\\\\\\\\\ BACKGROUND TASKS /////////////////// : FALLER BEGIN RNDLEN RNDX 0 FALLING AGAIN ; : ERASER BEGIN RNDX 0 AT-XY 24 0 DO PAUSE BL VPUT VROW++ 50 MS LOOP AGAIN ; CREATE GREENS 13 , 3 , 4 , : RND-GREEN ( -- n) 3 RND CELLS GREENS + @ ; : SPARKLER \ switches charsets to random greens, random times BEGIN 16 RND-GREEN 1 COLOR 50 RND MS 17 RND-GREEN 1 COLOR 50 RND MS 18 RND-GREEN 1 COLOR 50 RND MS 19 RND-GREEN 1 COLOR 50 RND MS 20 RND-GREEN 1 COLOR 50 RND MS 21 RND-GREEN 1 COLOR 50 RND MS AGAIN ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ SPAWN allocates USER area in Low RAM, FORKS, \ sets the awake flag and assigns a Forth word to RUN : SPAWN ( xt -- ) USIZE MALLOC DUP FORK DUP WAKE ASSIGN ; : SPAWN-JOBS ( --) ['] FALLER SPAWN ['] FALLER SPAWN ['] FALLER SPAWN ['] ERASER SPAWN ['] ERASER SPAWN ['] SPARKLER SPAWN ; HEX 83D6 CONSTANT ALWAYS \ screen timeout control DECIMAL : RUN GRAPHICS CLEAR 1 SCREEN Japanese 128 ]PDT 30 8* VWRITE \ GREEN charset Japanese 176 ]PDT 30 8* VWRITE \ WHITE charset INIT-MULTI SPAWN-JOBS 128 SET# 168 SET# 4 1 COLORS ( green) 176 SET# 228 SET# 16 1 COLORS ( white) MULTI ALWAYS ON \ prevent screen timeout BEGIN \ the console task loops to test the break key PAUSE ?TERMINAL UNTIL SINGLE 8 SCREEN BL SET# [CHAR] Z SET# 2 1 COLORS BYE ; LOCK INCLUDE DSK1.SAVESYS ' RUN SAVESYS DSK5.THEMATRIX updated-matrix-screensaver.mp4 THEMATRIX.ZIP 3 Quote Link to comment Share on other sites More sharing options...
+arcadeshopper Posted November 26, 2021 Share Posted November 26, 2021 17 hours ago, TheBF said: I spent some time reviewing files for a Github refresh and found this "THEMATRIX" demo screen saver. It also is a good demo of how to spawn tasks in low RAM at startup time so you don't take program space the task memory. I think it looks better now and the screen doesn't timeout now (duh!) so I made it into a binary program and it could be a cute screen saver. Reveal hidden contents \ THE MATRIX Multi-tasking demonstration Brian Fox 2021 \ NEEDS DUMP FROM DSK1.TOOLS \ DEBUG NEEDS MARKER FROM DSK1.MARKER NEEDS MALLOC FROM DSK1.MALLOC NEEDS RND FROM DSK1.RANDOM NEEDS COLOR FROM DSK1.GRAFIX NEEDS SPRITE FROM DSK1.DIRSPRIT NEEDS FORK FROM DSK1.MTASK99 : HEX#, ( addr len --) \ can be used for longstrings (128 bytes) BASE @ >R \ save radix HEX \ we are converting hex numbers in the string BEGIN DUP WHILE \ while len<>0 2DUP DROP 4 \ get 4 digits from left end of string NUMBER? ABORT" Bad number" \ convert string to number , \ compile the integer into memory 4 /STRING \ cut 4 digits off left side of string REPEAT 2DROP R> BASE ! \ restore radix ; CREATE Japanese DECIMAL S" 007E087E08300000" HEX#, S" 007E020202027E00" HEX#, S" 0044442404043800" HEX#, S" 0000600464087000" HEX#, S" 0004081030501000" HEX#, S" 0028282828284400" HEX#, S" 0000107C107C1000" HEX#, S" 003C448404041800" HEX#, S" 003C000000007E00" HEX#, S" 003E020214080400" HEX#, S" 0004040404043800" HEX#, S" 0042424242023C00" HEX#, S" 007C107C100C0000" HEX#, S" 007C007C007C0000" HEX#, S" 007C007C04380000" HEX#, S" 007C44A404380800" HEX#, S" 007E020438448000" HEX#, S" 0020203824202000" HEX#, S" 00107C1424480000" HEX#, S" 00087C0808300000" HEX#, S" 00407C4040403C00" HEX#, S" 00007C007C106000" HEX#, S" 00287C2808301400" HEX#, S" 0060600404047800" HEX#, S" 0054540404381400" HEX#, S" 007C04281028C400" HEX#, S" 007C040404043800" HEX#, S" 0000107C04043800" HEX#, S" 007C101010107C00" HEX#, S" 00207C2420202000" HEX#, S" 00107C0438540000" HEX#, \ : .JAPAN CR 159 128 DO I EMIT LOOP ; .JAPAN \ : .JAPAN2 CR 207 176 DO I EMIT LOOP ; .JAPAN2 176 128 - CONSTANT WHITECHAR ( changes green character to white) : >WHITE ( greenchar -- whitechar) WHITECHAR + ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ : CLIP ROT MIN MAX ; : RNDCHAR ( -- c) 30 RND 128 + ; \ returns green charset only : RNDX 32 RND ; \ 31 CLIP ; : RNDLEN 19 RND 4 + ; : VROW++ ( -- ) VROW DUP @ 1+ 23 MIN SWAP ! ; : FALLING ( length col row -- ) AT-XY ( len ) 0 ?DO PAUSE RNDCHAR VPUT VROW++ RNDCHAR >WHITE VPUT 60 RND 10 + MS LOOP ; \ \\\\\\\\\\\\\\\\\\\\\ BACKGROUND TASKS /////////////////// : FALLER BEGIN RNDLEN RNDX 0 FALLING AGAIN ; : ERASER BEGIN RNDX 0 AT-XY 24 0 DO PAUSE BL VPUT VROW++ 50 MS LOOP AGAIN ; CREATE GREENS 13 , 3 , 4 , : RND-GREEN ( -- n) 3 RND CELLS GREENS + @ ; : SPARKLER \ switches charsets to random greens, random times BEGIN 16 RND-GREEN 1 COLOR 50 RND MS 17 RND-GREEN 1 COLOR 50 RND MS 18 RND-GREEN 1 COLOR 50 RND MS 19 RND-GREEN 1 COLOR 50 RND MS 20 RND-GREEN 1 COLOR 50 RND MS 21 RND-GREEN 1 COLOR 50 RND MS AGAIN ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ SPAWN allocates USER area in Low RAM, FORKS, \ sets the awake flag and assigns a Forth word to RUN : SPAWN ( xt -- ) USIZE MALLOC DUP FORK DUP WAKE ASSIGN ; : SPAWN-JOBS ( --) ['] FALLER SPAWN ['] FALLER SPAWN ['] FALLER SPAWN ['] ERASER SPAWN ['] ERASER SPAWN ['] SPARKLER SPAWN ; HEX 83D6 CONSTANT ALWAYS \ screen timeout control DECIMAL : RUN GRAPHICS CLEAR 1 SCREEN Japanese 128 ]PDT 30 8* VWRITE \ GREEN charset Japanese 176 ]PDT 30 8* VWRITE \ WHITE charset INIT-MULTI SPAWN-JOBS 128 SET# 168 SET# 4 1 COLORS ( green) 176 SET# 228 SET# 16 1 COLORS ( white) MULTI ALWAYS ON \ prevent screen timeout BEGIN \ the console task loops to test the break key PAUSE ?TERMINAL UNTIL SINGLE 8 SCREEN BL SET# [CHAR] Z SET# 2 1 COLORS BYE ; LOCK INCLUDE DSK1.SAVESYS ' RUN SAVESYS DSK5.THEMATRIX updated-matrix-screensaver.mp4 THEMATRIX.ZIP 9.04 kB · 3 downloads interesting it doesn't work in js99er.ner.. fine in classic99 though Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 26, 2021 Author Share Posted November 26, 2021 Well that's concerning. I never play with that one. I didn't do a full warm boot on the Forth system when I started it. It worked on Classic99 so I moved on. Can I give you another one to try? Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 26, 2021 Author Share Posted November 26, 2021 TheMatrix II. Slightly new internal code but with a proper WARM boot of the Forth system before starting the rest of the program. I tried to improve the shimmering of the green letters and twinkle the white ones a little. A few more threads. Spoiler \ THE MATRIX Multi-tasking demonstration Brian Fox 2021 \ NEEDS DUMP FROM DSK1.TOOLS \ DEBUG NEEDS MARKER FROM DSK1.MARKER NEEDS MALLOC FROM DSK1.MALLOC NEEDS RND FROM DSK1.RANDOM NEEDS COLOR FROM DSK1.GRAFIX NEEDS SPRITE FROM DSK1.DIRSPRIT NEEDS FORK FROM DSK1.MTASK99 : HEX#, ( addr len --) \ can be used for longstrings (128 bytes) BASE @ >R \ save radix HEX \ we are converting hex numbers in the string BEGIN DUP WHILE \ while len<>0 2DUP DROP 4 \ get 4 digits from left end of string NUMBER? ABORT" Bad number" \ convert string to number , \ compile the integer into memory 4 /STRING \ cut 4 digits off left side of string REPEAT 2DROP R> BASE ! \ restore radix ; DECIMAL CREATE Japanese S" 007E087E08300000" HEX#, S" 007E020202027E00" HEX#, S" 0044442404043800" HEX#, S" 0000600464087000" HEX#, S" 0004081030501000" HEX#, S" 0028282828284400" HEX#, S" 0000107C107C1000" HEX#, S" 003C448404041800" HEX#, S" 003C000000007E00" HEX#, S" 003E020214080400" HEX#, S" 0004040404043800" HEX#, S" 0042424242023C00" HEX#, S" 007C107C100C0000" HEX#, S" 007C007C007C0000" HEX#, S" 007C007C04380000" HEX#, S" 007C44A404380800" HEX#, S" 007E020438448000" HEX#, S" 0020203824202000" HEX#, S" 00107C1424480000" HEX#, S" 00087C0808300000" HEX#, S" 00407C4040403C00" HEX#, S" 00007C007C106000" HEX#, S" 00287C2808301400" HEX#, S" 0060600404047800" HEX#, S" 0054540404381400" HEX#, S" 007C04281028C400" HEX#, S" 007C040404043800" HEX#, S" 0000107C04043800" HEX#, S" 007C101010107C00" HEX#, S" 00207C2420202000" HEX#, S" 00107C0438540000" HEX#, \ : .JAPAN CR 159 128 DO I EMIT LOOP ; .JAPAN \ : .JAPAN2 CR 207 176 DO I EMIT LOOP ; .JAPAN2 \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 176 128 - CONSTANT WHITECHAR ( changes green character to white) : >WHITE ( greenchar -- whitechar) WHITECHAR + ; : RNDCHAR ( -- c) 30 RND 128 + ; \ returns green charset only : RNDCOL ( -- col) 32 RND ; \ : VACANT? ( col -- ? ) 0 >VPOS VC@ BL <> ; \ HEX \ : ISEMPTY ( col -- col') \ RNDCOL \ BEGIN \ DUP VACANT? \ WHILE \ PAUSE \ 1+ 1F AND \ REPEAT ; \ DECIMAL : RNDLEN 21 RND 4 + ; ( max will be 20+4=24 ) : VROW++ ( -- ) VROW DUP @ 1+ 23 MIN SWAP ! ; : FALLING ( length col row -- ) AT-XY 60 RND 4 + SWAP ( len ) 0 ?DO PAUSE RNDCHAR VPUT VROW++ RNDCHAR >WHITE VPUT DUP MS LOOP DROP ; \ \\\\\\\\\\\\\\\\\\\\\ BACKGROUND TASKS /////////////////// : FALLER BEGIN RNDLEN RNDCOL 0 FALLING AGAIN ; : ERASER BEGIN 32 RND 0 AT-XY 50 RND 10 + \ loop speed on stack 24 0 DO PAUSE BL VPUT VROW++ DUP MS \ delay to loop speed LOOP DROP \ DROP loop speed 200 RND MS AGAIN ; CREATE GREENS 13 , 3 , 4 , 13 , 4 , 3 , 13 , 3 , : ]GREEN ( n) 7 AND CELLS GREENS + ; \ circular access array : SHIMMER \ switches charsets to random greens, random times 0 \ first []green index BEGIN 22 16 DO 10 MS I OVER ]GREEN @ 1 COLOR 1+ \ increment index LOOP 20 MS AGAIN ; : TWINKLE ( colorset -- ) PAUSE DUP 15 1 COLOR 10 MS 16 1 COLOR \ back to white 10 MS ; : TWINKLER BEGIN 26 22 \ white character sets DO I TWINKLE 300 MS LOOP AGAIN ; \ : TEST BEGIN 22 16 DO I ]GREEN @ . LOOP ?TERMINAL UNTIL ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ SPAWN allocates USER area in Low RAM, FORKS, \ sets the awake flag and assigns a Forth word to RUN : SPAWN ( xt -- ) USIZE MALLOC DUP FORK DUP WAKE ASSIGN ; : SPAWN-JOBS ( --) ['] FALLER SPAWN ['] FALLER SPAWN ['] FALLER SPAWN ['] FALLER SPAWN ['] ERASER SPAWN ['] ERASER SPAWN ['] ERASER SPAWN ['] SHIMMER SPAWN ['] TWINKLER SPAWN ; HEX 83D6 CONSTANT ALWAYS \ screen timeout control : CHARACTERS ( n -- ) 8* ; \ characters to write to pattern table DECIMAL : RUN WARM GRAPHICS CLEAR 1 SCREEN \ source dest. Quantity \ ------ ---- ---------- Japanese 128 ]PDT 30 CHARACTERS VWRITE \ GREEN charset Japanese 176 ]PDT 30 CHARACTERS VWRITE \ WHITE charset INIT-MULTI SPAWN-JOBS 128 SET# 168 SET# 4 1 COLORS ( green) 176 SET# 228 SET# 16 1 COLORS ( white) MULTI ALWAYS ON \ prevent screen timeout BEGIN \ the console task loops to test the break key PAUSE ?TERMINAL UNTIL SINGLE \ 8 SCREEN \ BL SET# [CHAR] Z SET# 2 1 COLORS BYE ; LOCK INCLUDE DSK1.SAVESYS ' RUN SAVESYS DSK5.THEMATRIX THEMATRIXII.zip 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.