Jump to content

TheBF

+AtariAge Subscriber
  • Content Count

    3,166
  • Joined

  • Last visited

Posts posted by TheBF


  1. I found out late in the day that yesterday was national beer drink day.

     

    https://www.daysoftheyear.com/days/drink-beer-day/

     

    Thankfully I had just enough time to enjoy a very dark ale from Ireland while watching TV.

     

    In honour of this auspicious day, I thought I would take the opportunity to show how you can create your own language in Forth. (Of course I had to tie that in)

     

    Here is a program written in my new language called BREWER

    : BEERS ( n -- )   \ Usage:  99 BEERS
          POPONE
          DRINK
             HOWMANY BOTTLES OF BEER ON THE WALL ,
             HOWMANY BOTTLES OF BEER ,
             TAKE ONE DOWN PASS IT AROUND ,
             ONELESS BOTTLES OF BEER ON THE WALL .
          ANOTHER 
          HANGOVER ;
    

    And on the off chance that anyone cares... here is the source code for the language. :-)

     

     

     

    \ 99 bottles of beer.  Create a beer language and write the program
    
    DECIMAL
    : CASE    ( -- 0 )  0  ; IMMEDIATE
    : OF      ( -- )   POSTPONE OVER   POSTPONE =   POSTPONE IF  POSTPONE DROP  ; IMMEDIATE
    : ENDOF   ( -- )   POSTPONE ELSE ; IMMEDIATE
    : ENDCASE ( -- )   POSTPONE DROP   BEGIN ?DUP WHILE  POSTPONE THEN   REPEAT ; IMMEDIATE
    
    : BOTTLES ( n -- )
            DUP
            CASE
             1 OF    ." One more bottle " DROP ENDOF
             0 OF    ." NO MORE bottles " DROP ENDOF
                     . ." bottles "    \ DEFAULT CASE
            ENDCASE ;
    
    : ,   [CHAR] , EMIT  SPACE 100 MS CR ;
    : .   [CHAR] . EMIT  300 MS  CR CR CR ;
    
    : HANGOVER    ." :-("  CR QUIT ;
    
    : OF       ." of "   ;
    : BEER     ." beer " ;
    : ON       ." on "   ;
    : THE      ." the "  ;
    : WALL     ." wall" ;
    : TAKE     ." take " ;
    : ONE      ." one "  ;
    : DOWN     ." down, " ;
    : PASS     ." pass " ;
    : IT       ." it "   ;
    : AROUND   ." around" ;
    
    : POPONE    1 SWAP CR ;
    : DRINK     POSTPONE DO ; IMMEDIATE
    : ANOTHER   POSTPONE -1  POSTPONE +LOOP ; IMMEDIATE
    : HOWMANY   S" I " EVALUATE ; IMMEDIATE
    : ONELESS   S" I 1- " EVALUATE ; IMMEDIATE

     

     

     

    Please drink responsibly

     

     

     

     

    • Like 2

  2. A long time ago I came across an article in BYTE magazine (April 1991) about some medical doctors (really) who figured out a great improvement to bubble sort by trial and error.

    The COMB sort is similar to the Shell Metzner in that is compares items in the array that are separated by a 'GAP'.

    The difference is in how you calculate the GAP.

     

    Comb sort uses a magic value of 1.3. Each time through the array, the GAP is divided by 1.3.

    This gives an amazing improvement over BUBBLE sort with only a couple of extra lines of code

    And the bigger the array the better the improvement, but even on 32 chars it is 10X faster. :-)

     

    I have provided two simple DEMO programs that sort characters on the screen for anyone who might need a sort routine.

     

    Bubble sort demo

     

     

     

    100 REM Bubble Sort DEMO
    120 REM a simple sort
    130 CALL CLEAR
    135 CALL SCREEN(12)
    140 PRINT "*BUBBLE SORT DEMO*"
    150 LET SIZE=31
    
    210 REM write chars to screen
    220 C=64+SIZE
    230 FOR I=1 TO SIZE
    240   CALL HCHAR(10,I,C,1)
    250   C=C-1
    260 NEXT I
    
    400 REM sort chars on screen
    420 LET PASSES=0
    
    430 REM start of loop
    440 SORTED=1
    
    450 FOR I=1 TO SIZE-1
    452   CALL GCHAR(10,I,X)
    454   CALL GCHAR(10,I+1,Y)
    460   IF X<Y THEN 530
    480   CALL HCHAR(10,I,Y)
    490   CALL HCHAR(10,I+1,X)
    520   SORTED=0
    530 NEXT I
    540 PASSES=PASSES+1
    550 REM test if sort is finished
    560 IF SORTED=1 THEN 600
    570 GOTO 440
    
    600 PRINT "Sort completed in";PASSES;"times through the array"
    640 END
    650 REM 272.5 sec.
    

     

     

     

     

     

     

    100 REM Comb Sort DEMO
    120 REM a faster simple sort
    130 CALL CLEAR
    135 CALL SCREEN(12)
    140 PRINT "*COMB SORT DEMO*"
    150 LET SIZE=31
    
    210 REM write chars to screen
    220 C=64+SIZE
    230 FOR I=1 TO SIZE
    240   CALL HCHAR(10,I,C,1)
    250   C=C-1
    260 NEXT I
    
    400 REM sort chars on screen
    420 PASSES=0
    425 GAP=SIZE
    430 REM start of loop
    440 SORTED=1
    442    GAP=INT(GAP/1.3)
    450    FOR I=1 TO SIZE-GAP
    452      CALL GCHAR(10,I,X)
    454      CALL GCHAR(10,I+GAP,Y)
    460      IF X<Y THEN 530
    480      CALL HCHAR(10,I,Y)
    490      CALL HCHAR(10,I+GAP,X)
    520      SORTED=0
    530    NEXT I
    540 PASSES=PASSES+1
    550 REM test if sort is finished
    560 IF (GAP=1) THEN 600
    570 GOTO 440
    
    600 PRINT "Sort completed in";PASSES;"times through the array"
    640 END
    650 REM 25.6 sec.
    
    

     

     

     

    • Like 6

  3. A nice random number routine I got years ago and have used ever since is here. It has two nice features - one is that a seed that's off by even one with give you a very different sequence - which is good for the numbers we tend to have. The second is that it guarantees to produce every number from 1-65535 exactly once before repeating, in a pseudo random order (note that 0 is not included).

     

    Another thing I like to do is instead of just incrementing the key, I'll often call the random function. I'm not sure if one is better than the other, offhand. ;)

     

    *RND	RETURN RANDOM NUMBER IN R0 
    RMASK
    	DATA >B400		* mask for 16 bit random numbers
    RND
    	MOV  @RNDSED,R0         * Get seed
    	SRL  R0,1		* shift down
    	JNC  RAND01		* jump if 1 not shifted out
    	XOR  @RMASK,R0		* XOR the top half
    RAND01
    	MOV  R0,@RNDSED         * Save this number for next time 
    	B    *R11 
    (edit: sorry, removed the 'inc @zmquad' - that was obviously part of the Zombie MOTIF game ;) )

     

     

    I have not been following this thread until today, but over here:

     

    http://atariage.com/forums/topic/264144-forth-and-basic-graphic-program-comparison/page-2

     

    I mentioned the GForth random number generator which also repeats after 2^16 and has a better histogram. It uses the MPY instruction internally.

    The TI-Forth PRNG code seems to repeat after 20K+ or so numbers so I preferred the GForth method.

     

    Yours is even more elegant using only (EDIT: OOPS.) divide by 2 with SRL.

     

    Very nice.


  4.  

    Somebody must have wanted that 'feature' at one point, but if nobody sees the value I can change it to not exclude empty characters.

     

    This might be a little out there, but a programmable report generator would be a cool next version, where people who use "weird" languages can format the output file in different ways.

    It would also let you write your current output formats in the report generator and maybe reduce the amount of "hard code" dedicated to this purpose.

     

    Just a thought.


  5.  

     

    Seriously though, C++ is not so foreign - any BASIC programmer could pick it up easily,

     

     

     

    I think C++ objects and object libraries are a pretty big mind shift for a BASIC programmer.

    If you just want to use C++ as a C compiler then it gets a little more straightforward, but even still, handling strings and arrays as pointers can be challenging for a newbie C programmer.

     

    Python would be a little bit closer would it not?

     

    And if a TI-BASIC library can be added to BACON or something like it, you have your C++ compiler (GCC) and let people program in a BASIC dialect.


  6. A "C" compiler for TI-Basic that only uses a special library restricting it to what can be compiled?

     

    C as the output language of a compiler has been known to work very well.

    That's a good idea. Not that simple to make but it would perform well I think.

     

    Doable with something like YACC/BISON or those kind of programs I should think.


  7. While trolling through the library code for GForth, the GNU Forth system, I found a random number generator.

     

    I uses a very simple algorithm and might be useful to Assembly language programmers here.

    Here is the Forth Code:

    \ generates random numbers                             12jan94py
    
    \ Copyright (C) 1995,2000,2003,2007 Free Software Foundation, Inc.
    
    \ This file is part of Gforth.
    
    \ Gforth is free software; you can redistribute it and/or
    \ modify it under the terms of the GNU General Public License
    \ as published by the Free Software Foundation, either version 3
    \ of the License, or (at your option) any later version.
    
    \ This program is distributed in the hope that it will be useful,
    \ but WITHOUT ANY WARRANTY; without even the implied warranty of
    \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    \ GNU General Public License for more details.
    
    \ You should have received a copy of the GNU General Public License
    \ along with this program. If not, see http://www.gnu.org/licenses/.
    
    \ From Gforth, modified for CAMEL99 system
    HEX 
    83C0 CONSTANT SEED   \ RAM where TI has a number incrementing in main menu
    1045 CONSTANT GEN#   \ GForth uses $10450405  \ taking the 1st 16 bits
    
    : RND  ( -- N )  SEED @ GEN# UM* DROP 1+ DUP SEED ! ;
    : RANDOMIZE ( N -- 0..N-1 )  RND UM* NIP ;  (edit: CORRECTED this code with UM*)
    
    

    If we were to translate it to infix notation as a function in integer BASIC it would something like this:

    The multiplication (UM*) in Forth is unsigned, mixed multiply ( int*int->double) which is really just the TMS9900 MPY instruction.

    Nice and easy.

    DEF RND()
        R=SEED*GEN#+1
        SEED=R
    

    The cool thing is where the TI-Forth algorithm repeats after 20,000 ints or so, this one repeats after 65,536 and the Histogram is very flat.

    In both cases I started with the >3567 seed value used by TI-BASIC just for consistency. (Thanks Lee)

    Increased my histogram samples to 320 to give all 32 buckets a potential 10 random numbers which seemed a better way to do it.

     

    Might be useful to someone making games.

     

    PS

    For reference I re-did the TI-BASIC histogram using 320 random samples.

    post-50750-0-48883900-1505691442.jpg

    post-50750-0-73785900-1505691756.jpg

    post-50750-0-64393200-1505691920.jpg


  8. So I ran some of the *HAYES tester on my Forth system and guess what?

     

    I coded my bit shifting words in a way that made them FAIL. No shock because I didn't read the spec. (DUH)

     

    In the WORD [email protected] in my earlier post, I added an IF statement to cope with a 0 bit shift. Well the ANS/ISO Forth standard already anticipated that.

    So I recoded my shift words (LSHIFT & RSHIFT) to pass the test and now [email protected] is much faster and much simpler.

     

    I have edited the previous POST to reflect the correction.

    : [email protected]      ( bit# addr -- ? )
                  BITFLD @               \ compute bit# & fetch bits in cell
                  SWAP RSHIFT            \ if bit#<>0 RSHIFT,
                  0001 AND ;             \ mask 1 bit
    

    * The Hayes tester is set of test words and test suites for every standard Forth word that let's you confirm that a Forth WORD is doing what it's supposed to do.

    It looks like this for a simple word like SWAP:

     

    T{ 1 2 3 SWAP -> 1 3 2 }T

     

    ​You get OK if the output swap matches the '1 3 2' after the arrow and an error message if not.

     

    To read more: http://forth-standard.org/standard/testsuite

    • Like 1

  9. Could the LOAD line be confiscated and used to create a proper RS232 interrupt?

     

    What I mean by proper is used for RS232 only, so as to reduce the size and complexity of the ISR allowing faster communication and lower overhead on the main program.

     

    It would require running a connection from the RS232 card. I have not looked at the drawings to see if there are any open pins on the Expansion box buss. And based on Tursi's response on multiple triggers it might want some conditioning logic added to the RS232 board.

     

    I kind of salivate knowing there is an available interrupt vector in RAM. :)


  10. There is sort of a conflict of interest here.

    The simplest context to write assembly language programs for are those that are completely self-supporting. They start, they run and do their own thing and they end by a system reset. Hence as long as you take control (don't allow interrupts), you can use all resources in the machine and do whatever you like.

    Things get a bit more complex if you want to use routines in the machine as subroutines for your own code. If you want to use the floating point math, for example, then you must adapt to how they are written. If they use GPL WS, FAC and ARG areas in scratch pad RAM, then you can't store your things there and suspect them to survive.

    It gets even more complex if you want to add assembly support routines to another environment, like Extended BASIC or Pascal. In such a case, you must respect the fact that these environments have mapped all of scratch pad RAM, and some other RAM too, for their own purpose, and only selected parts can be modified without ruining the capability to return to the calling environment.

     

    For a game or major other application (like TI-Writer), the self-supporting route is no problem. But I've almost always found the best use of assembly to augment Extended BASIC or Pascal, and then you need to be careful. That's when consoles with all 16-bit RAM are good, as there's no speed penalty for me, regardless of where the workspace is or the code runs.

     

    That is excellent advice Apersson850.

     

    It's also important to balance the expected speed of your assembly code versus your XB or Pascal application speed.

    My point is, even if you use 8 bit RAM for your workspace, the upgrade in speed is still many many times faster than your hi level language speed.

     

    So I like the Steve Jobs approach:

     

    "Make it work, then make it better"

     

    B

    • Like 1

  11.  

    I just assumed speed was the reason you did not use the PDT. Of course, we all know what “assume” does.

     

    ...lee

     

     

    The think you assumed perhaps, that I am as smart as you are. :)

    It takes me a little longer to connect the dots or bits as in this case.

     

    I was out of this arena for over 20 years doing product marketing and then general management. (be kind)

    There are lots of rusty parts in this old head about software and Forth, but I am applying a little oil every day.

     

    B


  12. As I looked at this code I realized that the TI-99 already has a bit pattern for all the characters in the VDP RAM.

    In CAMEL99 I call the pattern table PDT and you can access the pattern address of any character with ]PDT.

     

    So I removed the UPPER case filter and the offset used to start all characters at >20 (space character) and substituted ]PDT.

    With this I can get the bit pattern for any ASCII character in the TI-charset.

     

    Then I replaced the memory character fetch ( [email protected] ) with the VDP version ( [email protected] ) so that I read the pattern from VDP RAM.

     

    After those changes I can print out any TI-99 character in this banner form without using another table of patterns.

     

    That saves a lot of space since I only need this code and it works.

    : BANNER ( str len -- )
        8 0 DO  CR                       
               2DUP BOUNDS       \ convert str,len to end/start addresses
    ​           ?DO               \ I is address of each char in string
                  I [email protected] ]PDT J +  [email protected]    \ read VDP byte PDT[ascii,j]              
    ​              2 7 DO
                        DUP 1 I LSHIFT AND
                        IF  ." #"  ELSE  ."  "  THEN
                  -1 +LOOP  
    ​              DROP  
               LOOP                       
        LOOP  
    ​    2DROP ;
    

    post-50750-0-06331100-1504845761.gif

    • Like 3

  13. As I am testing out my system I am trying to run other peoples Forth Code.

    This BANNER routine uses a data matrix to define big fonts. All I had to do was add my version of the UPPER routine to convert chars

    and my BYTES word to compile the data matrix and it worked.

     

     

     

    \ BANNER    Wil Baden  2003-02-23  R.I.P.
    
    \  *******************************************************************
    \  *                                                                 *
    \  *  Wil Baden  2002-08-07                                          *
    \  *                                                                 *
    \  *  BANNER                                                         *
    \  *                                                                 *
    \  *     Display short phrase in ####   ###   ####                   *
    \  *                             #   #   #   #                       *
    \  *                             #   #   #   #                       *
    \  *                             ####    #   #                       *
    \  *                             #   #   #   #  ##                   *
    \  *                             #   #   #   #   #                   *
    \  *                             ####   ###   #### letters.          *
    \  *                                                                 *
    \  *******************************************************************
    
    \ change to the original to use CAMEL99 parlance
    : BETWEEN   ( n n n -- ? ) 1+ WITHIN ;
    : LOWER?    ( char -- ?)  [CHAR] a [CHAR] z BETWEEN ;
    
    HEX
    : UPPER   ( c -- c )    DUP LOWER? IF  05F AND THEN ;
    
    \ compiler addition to compile bytes into memory
    : BYTES ( -- )
             BEGIN
                BL WORD COUNT $BUF PLACE
                $BUF [email protected]       \ fetch 1st char (string lenght)
             WHILE            \ while the string len>0
                $BUF ?NUMBER 0= ABORT" BAD#"
                C,            \ compile into next byte of memory
             REPEAT ;
    
    \  BANNER			( str len -- )
    \     Display short phrase in BIG letters.
    HEX
    CREATE Banner-Matrix
    BYTES     00 00 00 00 00 00 00 00  20 20 20 20 20 00 20 00
    BYTES     50 50 50 00 00 00 00 00  50 50 F8 50 F8 50 50 00
    BYTES     20 78 A0 70 28 F0 20 00  C0 C8 10 20 40 98 18 00
    BYTES     40 A0 A0 40 A8 90 68 00  30 30 10 20 00 00 00 00
    BYTES     20 40 80 80 80 40 20 00  20 10 08 08 08 10 20 00
    BYTES     20 A8 70 20 70 A8 20 00  00 20 20 70 20 20 00 00
    BYTES     00 00 00 30 30 10 20 00  00 00 00 70 00 00 00 00
    BYTES     00 00 00 00 00 30 30 00  00 08 10 20 40 80 00 00
    
    BYTES     70 88 98 A8 C8 88 70 00  20 60 20 20 20 20 70 00
    BYTES     70 88 08 30 40 80 F8 00  F8 10 20 30 08 88 70 00
    BYTES     10 30 50 90 F8 10 10 00  F8 80 F0 08 08 88 70 00
    BYTES     38 40 80 F0 88 88 70 00  F8 08 10 20 40 40 40 00
    BYTES     70 88 88 70 88 88 70 00  70 88 88 78 08 10 E0 00
    BYTES     00 60 60 00 60 60 00 00  00 60 60 00 60 60 40 00
    BYTES     10 20 40 80 40 20 10 00  00 00 F8 00 F8 00 00 00
    BYTES     40 20 10 08 10 20 40 00  70 88 10 20 20 00 20 00
    
    BYTES     70 88 A8 B8 B0 80 78 00  20 50 88 88 F8 88 88 00
    BYTES     F0 88 88 F0 88 88 F0 00  70 88 80 80 80 88 70 00
    BYTES     F0 48 48 48 48 48 F0 00  F8 80 80 F0 80 80 F8 00
    BYTES     F8 80 80 F0 80 80 80 00  78 80 80 80 98 88 78 00
    BYTES     88 88 88 F8 88 88 88 00  70 20 20 20 20 20 70 00
    BYTES     08 08 08 08 08 88 78 00  88 90 A0 C0 A0 90 88 00
    BYTES     80 80 80 80 80 80 F8 00  88 D8 A8 A8 88 88 88 00
    BYTES     88 88 C8 A8 98 88 88 00  70 88 88 88 88 88 70 00
    
    BYTES     F0 88 88 F0 80 80 80 00  70 88 88 88 A8 90 68 00
    BYTES     F0 88 88 F0 A0 90 88 00  70 88 80 70 08 88 70 00
    BYTES     F8 20 20 20 20 20 20 00  88 88 88 88 88 88 70 00
    BYTES     88 88 88 88 88 50 20 00  88 88 88 A8 A8 D8 88 00
    BYTES     88 88 50 20 50 88 88 00  88 88 50 20 20 20 20 00
    BYTES     F8 08 10 20 40 80 F8 00  78 40 40 40 40 40 78 00
    BYTES     00 80 40 20 10 08 00 00  F0 10 10 10 10 10 F0 00
    BYTES     00 00 20 50 88 00 00 00  00 00 00 00 00 00 00 F8
    
    DECIMAL
    : BANNER ( str len -- )
        8 0 DO  CR                       ( str len)
            2DUP BOUNDS ?DO              ( . .)
                I [email protected]  UPPER  BL -  0 MAX ( . . char)
                8 *  Banner-Matrix +  J +  [email protected] ( . . row)
                2 7 DO
                    DUP 1 I LSHIFT AND
                        IF  ." #"  ELSE  ."  "  THEN
                -1 +LOOP  DROP           ( . .)
            LOOP                         ( str len)
        LOOP  2DROP ;
    
    HEX
    : TEST
          PAGE
          17 7 VWTR
          BEGIN
            S" Camel" BANNER
            S" Forth" BANNER
            S" is"    BANNER
            S" fun!"  BANNER
            S"  " BANNER
          ^C?
          UNTIL ;
    
    \  Thanks to Marcel Hendrix.
    
    
    

     

     

    post-50750-0-10738900-1504800793.gif

    • Like 2

  14. Actually just LWPI >8300

    That way you wont't pollute R13, R14 and R15 in the Other workspace.

     

    And that only guarantees you 8300 to 830F (16 words of memory for registers)

     

    Consult the Editor Assembler manual for the usage of the memory at 8300 to 83FF

    • Like 1

  15. Well... the TI system is using the workspace at 83E0 and it kind of assumes it owns them.

     

    So if you want a full register set for your program, it's available.

    And if you don't change you have to save at least some of the registers in order to use them.

     

    Also it's simpler to let TI-99 keep it's workspace when you call some of the system calls like KSCAN and such.

     

    So the good news is there is a nice space at >8300 that is waiting for your program to use as a workspace.

    Take it and have 16 registers to yourself.

     

    B

    • Like 1

  16. I saw some super posts in the archives about sound ripppers and stuff related to sound so I thought I would take a run making a sound list player.

     

    All of this can be done in FB Forth or TF as well. However there are some words that will need adjustment.

    The missing words would be MS, which is just a quick delay loop.

     

    : MS 8 0 DO LOOP ; ( something like this, 8 is "about" the correct number for 1 MS)

     

    And PAUSE which is a noop.

     

    : PAUSE ; will fix that quickly.

     

    And ?NUMBER in CAMEL Forth is non-standard, but Lee created an equivalent in FB Forth for another one of my posts a while back.

    (Will find that and post here)

     

    However what a little player like this might be good for is trying out some data to listen to it for ALC programmers.

     

    You can feed it sounds lists from the keyboard and play them to see how you like the sound.

     

    Couple of things to be aware of:

     

    1. This player turns all 4 sound channels off when it gets to the end of a list with the word SILENT.

    If you use the TI player you will need to add the string of bytes to turn off your sounds.

     

    2. The BYTES word does not use commas, so sound lists tried here will have to have the commas removed.

     

    3. UN-comment SND! for other Forth systems or use the equivalent word to write a byte to the sound chip address.

     

    4. LSHIFT is the ANS Forth word, but TF uses << for the same thing I believe. Not sure about FB Forth .

     

    How it works:

     

    PLAY$ takes the address of a string of bytes with a count byte at the start and a time duration byte at the end.

    It converts the duration byte to milliseconds assuming a 1/60 of a second ISR time.

    It then computes the start and end address of the sound bytes and loops through them sending each one to SND! (the chip address)

    When the loop is completed it waits for the duration of milliseconds.

     

    PLAY Is the high level word to use for playing a sound list. It simply looks to see if there is a non-zero byte count in a sound string.

    While that is true is calls PLAY$.

    Then using the count byte it computes the address of the next string in the list and plays the next string until it hits a final ZERO.

     

    CREATE XXXX is Forth's way of making a new word in the Dictionary of words and will return the start of the data address of that new word.

     

    BYTES is a compiler directive that was created to parse the input stream, convert the data to a number and compile it into the next byte of memory.

    It could have been done with the C, primitive but it makes the lists harder to read ( example AA C, 7 C, DE C, ETC... )

     

    I believe the code here will run with the CAMEL99 version in GITHUB /BIN folder. (did not try it yet)

     

    I stole some sounds from PARSEC for FIRE and EXPLODE and I must confess it was a religious experience to hear those sounds come out my Forth system. ;-)

     

    If you get it working type:

     

    3 SHOTS at the console. That does 3 FIRE sounds and then runs the EXPLODE list. Memories...

     

     

     

    \ TI sound list player in CAMEL99 Forth
    \ 1. This player needs an extra 0  to mark the end of the sound data
    \ 2. It automatically turns off sound when the data is ended
    \ 3. Uses the TMS9901 timer to control sound duration 
    \    (Forth word MS is millisecond delay)
    
    \ : SND!  ( byte -- )  8400 C! ; ( in the CAMEL99 Kernel )
    
    : SILENT ( --)  9F SND!  BF SND!  DF SND! FF SND! ;  \ turn off all sounds
    
    : >MS    ( n -- n') 4 LSHIFT ;  \ n*16, converts ISR delay value to milliseconds
    
    : [email protected] ( snd$ -- ms) COUNT + [email protected] ; \ get time byte at end of string
    
    : PLAY$ ( sound_string -- ) \ play 1 sound string
           DUP [email protected] >MS   \ duration on stack for later leave for later
           SWAP COUNT          \ returns start address and length of string
           BOUNDS              \ convert addr/len to end-address, start-address
           ?DO
              PAUSE            \ give time to other tasks
              I [email protected] SND!        \ feed each byte to sound chip
           LOOP
           ( delay) MS ;       \ use the value we calculated that's on the stack
    
    : NEXTSND  ( snd$ -- )     \ next_string = startaddr + length + 1
                COUNT + 1+ ;
    
    : PLAY ( addr -- )         \ play a list of sound strings
           BEGIN
             DUP [email protected]
           WHILE               \ while the length is not 0
             DUP PLAY$         \ play a single string
             NEXTSND           \ advance to the next sound string
           REPEAT
           SILENT
           DROP ;              \ mom said always clean up after yourself
    
    \ compiler addition to compile bytes into memory
    : BYTES ( -- )
             BEGIN
                BL WORD COUNT $BUF PLACE
                $BUF [email protected]       \ fetch 1st char (string lenght)
             WHILE            \ while the string len>0
                $BUF ?NUMBER 0= ABORT" BAD#"
                C,            \ compile into next byte of memory
             REPEAT ;
    
    : /END   0 , ;            \ compile a zero into memory
    
    HEX
    CREATE SOUND1   ( Munchman )
           BYTES 08 85 2A 90 A6  08  B0  CC  1F  12
           BYTES 08 85 2A 90 A4  1C  B0  C9  0A  12
    /END
    
    CREATE SMACK
            BYTES 4 F2 CC 01 E7 1
            BYTES 2 CC 03 1
            BYTES 2 CC 05 1
    /END
    
    CREATE PACMAN
            BYTES 6 86 0D 97 AC 1A B7 8
    	BYTES 2 8F 08 2
    	BYTES 2 AB 23 5
    	BYTES 2 86 0D 4
    	BYTES 1 BF 3
    	BYTES 2 8E 0B 8
    	BYTES 2 8A 0A 2
    	BYTES 3 AC 1A B7 8
    /END
    
    CREATE EXPLODE   ( from Parsec )
           BYTES 7 9F BF DF E7 F0 C0 07 5
           BYTES 1 F1 6
           BYTES 1 F2 7
           BYTES 1 F3 8
           BYTES 1 F4 9
           BYTES 1 F5 10
           BYTES 1 F6 11
           BYTES 1 F7 12
           BYTES 1 F8 13
           BYTES 1 F9 14
           BYTES 1 FA 15
           BYTES 1 FB 16
           BYTES 1 FC 17
           BYTES 1 FD 18
           BYTES 1 FE 30
           BYTES 1 FF 0
    /END
    
    CREATE FIRESND   ( from Parsec )
           BYTES 4 9A BF DF FF 1
           BYTES 3 80 0A 98 1
           BYTES 3 80 0C 96 1
           BYTES 3 80 10 94 1
           BYTES 3 80 14 92 1
           BYTES 3 80 18 90 1
           BYTES 3 80 1C 92 1
           BYTES 3 80 20 94 1
           BYTES 3 80 28 96 1
           BYTES 3 80 30 98 1
           BYTES 3 80 38 9A 1
           BYTES 3 80 3E 9C 1
           BYTES 1 9F 0
    /END
    
    : SHOTS  ( n -- )  0 ?DO  FIRESND PLAY  LOOP  EXPLODE PLAY ;

     

     

    • Like 3

  17.  

    Are the horizontal lines slightly bent ?

     

    100 call clear::call screen(14)::call color(6,1,1,7,1,1)::c$="FF"&rpt$("80",15)&"FF"&rpt$("0",15)
    110 call char(72,c$,80,c$)::c$=rpt$("HJPR",&rpt$("IKQS",::for i=0 to 23
    120 display at(i+1,1):seg$(c$,3+32*(i and 1)+abs((i and 6)/2-2),28);
    130 next i::call color(6,1,2,7,1,16):: for i=0 to 9^9::next i
    run
     
    

     

    This points to some deep insights into the architecture of our brains.

    I don't know what exactly, but the fact that we can't see the parallel lines clearly makes me wonder what else do I misperceive?

    I suspect that answer is a great deal!

     

    And if anybody here sees the parallel lines clearly, they are either a mutant or should maybe see their doctor :-)

     

    Thanks Sometimes99er!

     

    B

    • Like 1

  18. array [0..999] of char, just like array[0.999] of boolean, still occupies 1000 words, as each character/boolean is stored in one word (16 bits). The system can't allocate a 10000 word array.

     

    Now if you declare a packed array[0.999] of char, then that's 500 words, and a packed array[0..999] of boolean is only 63 words. But then you have to add the overhead for packing and unpacking when accessing the array. So it works, but will take longer time.

     

    I'm not sure which boundaries you are referring to, when asking if the p-system can handle arrays across boundaries? There are no boundaries to cross in this case.

     

    I always like the way Wirth's languages have these different data types. Forth makes you work hard for that nice stuff.

    So in my Pascal Envy fever I thought I would see what it would take to make a "packed array of bits" and it is more code than I thought.

     

    The overhead just to set 1 bit, according to the CLASSIC99 9901 timer is 1.8 milli-seconds in my Forth system.

     

    EDIT: New times 1.5mS to set a bit.

    1.1mS to read a bit ([email protected])

     

    This could be really sped up with assembly language code words but it's still a lot of work to strip out bits.

     

     

    EDIT: Here is the revised code with fixed RSHIFT and uses CELL+ and CELLS to be less platform dependant.

    \ BOOLEAN array experiment
    
    \ BOOLEAN data is one CELL (16 bits on TMS9900)
    
    HEX
    \ create & erase memory area for 'n' bits
    : BITS:  ( n -- ) CREATE    8 /  HERE OVER 0 FILL  CELL+  ALLOT  ;  \ added 2 bytes extra
    
    \ compute bit# in a cell & cell address
    : BITFLD     ( bit# addr[] -- bit#' addr)
                   SWAP 10 /MOD CELLS ROT +  ;
    
    : [email protected]      ( bit# addr -- ? )
                  BITFLD @               \ compute bit# & fetch bits in cell
                  SWAP RSHIFT            \ if bit#<>0 RSHIFT,
                  0001 AND ;             \ mask 1 bit
                  
    : BIT#>MASK ( bit# -- n )  0001 SWAP LSHIFT ;
    
    : BSET      ( bit# addr[] -- )
                  BITFLD                   ( -- bit# addr)
                  SWAP BIT#>MASK >R        \ save the mask
                  DUP @                    \ -- addr bits
                  R> OR SWAP ! ;           \ or mask into bit, store in addr
    
    : BRST      ( bit# addr[] -- )
                  BITFLD                   ( -- bit# addr)
                  SWAP BIT#>MASK INVERT >R  \ invert and save mask
                  DUP @                     \ -- addr bits
                  R> AND SWAP ! ;           \ mask out bits, store back in addr
    
    
    \ test code
     DECIMAL
      300 BITS: ]X      \ make array X of 1000 bits
    
    : FILLBITS   300 0 DO  I ]X BSET   LOOP ;
    : CLRBITS    300 0 DO  I ]X BRST   LOOP ;
    : EVENBITS   ." Erasing..."  CLRBITS 300 0 DO  I ]X BSET   2 +LOOP ;
    : SHOWBITS   300 0 DO  I ]X [email protected] . LOOP ;
    
    
×
×
  • Create New...