Jump to content

TheBF

+AtariAge Subscriber
  • Posts

    4,469
  • Joined

  • Last visited

Posts posted by TheBF

  1. 53 minutes ago, Vorticon said:

    Is there way to use a non-absolute displacement for SBO, SBZ and TB? I've tried a couple of ways, using a register and a memory location containing a displacement but I got an assembler error.

     

    Change the value in R12 ?

    As far as I know you can move R12 and then use SBO 0  SBZ 0 

    So you could make different EQUates for R12 contents to set the different base address/es you want to work on. 

    This might not be considered good practice but you know ...

     

    • Like 1
  2. Man you have done a great deal of work.  It's a really nice system. Very polished.

    The modes all seem to switch nicely. 

    I still love SPLIT2  for the editor. 

     

    We spoke about having the 64 col. editor bouncing down to the text window when you escape the editor.

    This lets you see your code and manually test it so easily.  

    I never did give you my changes to the TI Forth 60col editor for that.

    Is that something you could use now?

     

    • Like 1
  3. Thought I would beat this thing up.  I used the Ultimate Benchmarks 1Million Nesting test with a twist.

    Every call is too a different SAMS page. Totally brutal.

     

    So it looks like calling a paged Forth word takes about 4 times longer than a regular call. 

    Not too bad. I removed the instructions that test if the SAMS page is already in memory because it added 2 instructions to skip 6 instructions.

    In a test like this it makes things even slower. It might still be worth having for code that uses lots of stuff in the same block. 

     

    I am going to see if it compiles and runs on real iron.  <scary music here>

     

    Here are the results

    \ Normal Forth nesting   
    \  TurboForth 1.21     Nesting 1Mil  2:29
    \  Camel99 Forth ITC   Nesting 1Mil  2:30
    \  Camel99 SAMS card   Nesting 1Mil ~10:00  !!!
    

     

    Here's the code:

    Spoiler
    \ Source:  https://www.theultimatebenchmark.org/
    
    \ Normal Forth nesting   
    \  TurboForth 1.21     Nesting 1Mil  2:29
    \  Camel99 Forth ITC   Nesting 1Mil  2:30
    \  Camel99 SAMS card   Nesting 1Mil ~10:00  !!!
    
    >RAM 
    INCLUDE DSK1.ELAPSE 
    
    >SAMS 
    DECIMAL 
    240 CODEPAGE  : BOTTOM ;
    
    241 CODEPAGE : 1st BOTTOM BOTTOM ;  
    242 CODEPAGE : 2nd 1st 1st ;      
    243 CODEPAGE : 3rd 2nd 2nd ;
    244 CODEPAGE : 4th 3rd 3rd ;   
    245 CODEPAGE : 5th 4th 4th ;      
    246 CODEPAGE : 6th 5th 5th ;
    247 CODEPAGE : 7th 6th 6th ; 
    248 CODEPAGE : 8th 7th 7th ;      
    249 CODEPAGE : 9th 8th 8th ;
    250 CODEPAGE : 10th 9th 9th ;
    251 CODEPAGE : 11th 10th 10th ;   
    252 CODEPAGE : 12th 11th 11th ;
    253 CODEPAGE : 13th 12th 12th ;     
    254 CODEPAGE : 14th 13th 13th ;   
    255 CODEPAGE : 15th 14th 14th ; \ Highest page with 1M SAMS
    241 CODEPAGE : 16th 15th 15th ;     
    242 CODEPAGE : 17th 16th 16th ;   
    243 CODEPAGE : 18th 17th 17th ;
    244 CODEPAGE : 19th 18th 18th ;    
    245 CODEPAGE : 20th 19th 19th ;   
    
    
    :  1MILLION  CR ."  1 million SAMS nest/unnest operations"  20th ;
    

     

     

    • Like 1
    • Haha 1
  4. 3 hours ago, OLD CS1 said:

    TI BASIC underestimates the power of Swiftie money.  The story is already written.

    Are implying that somehow the SuperBowl,

    that bastion of American culture,

    with the most amazing half-time show,

    the best and most expensive commercials ever conceived by mortals

    and the biggest sporting event in the *world...

     

    is somehow rigged? 

     

     

     

    *Where world means the USA. ;)

     

     

     

    • Haha 2
  5. Well the next demo I looked at was putting Forth code into SAMS RAM.

    I had always been P___d-off that CREATE DOES> words did not work.

    I finally figured out why.  

     

    I had started with Mark's ( @Willsy )  excellent example from Turbo Forth. It allowed me to get my head around a method to do this. 

    Mark's code uses the normal ':' and ';'  operators with some very clever use of COMPILE.

     

    But you know, I had to try some ideas. I wanted to reduce the size of the headers and also move the ';' (EXIT) code over to the SAM memory.

    So I made some ALC for FARCOL and FAREXIT.  This means that my 'FAR:' for SAMS is specific.

     

    The reason why CREATE DOES> fails in my version is that I need to make  'FARCREATE' to be compatible with what I did. 

    So I spent along time last week trying to fix something that wasn't broken, just not finished! :)

    But at least I have what seems like a solid version for Camel99 Forth. Actually I have two. One is a TURBOFORTH compatible file and then my version. 

     

    As a test I did this:

    DECIMAL
    240 CODEPAGE 
    \ 1 SETBANK ( for TurboForth version) 
    HERE 
    : HELLO   CR ." Hello SAMS World!"  ;
    HERE SWAP - . 
    
    INCLUDE DSK1.ANSFILES
    INCLUDE DSK1.DIR
    INCLUDE DSK1.MORE 
    INCLUDE DSK1.CATALOG 

     

    So I still have to make FARCREATE but I think I have achieved my original goal of making things a bit smaller. 

    \ SAMS CODE  TF    CF
    \ headers  = 1290   850 
    \ code     = 1684  1594 
    \ total      2974  2444  

     

    Spoiler
    \ SAMSCODE.FTH                for Camel99 Forth  Brian Fox
    \ Code in SAMS memory based on concept in TurboForth by Mark Wills
    \ Ported to Camel99 Forth with changes Oct 13, 2021,
    
    \ Concept:
    \ FAR: word headers are in the normal Forth memory space so all SAMS words
    \ can be found.
    \ FAR: word data structure has two extra fields
    \ <link> < HEADER> <imm> <len NAME..> <FARCOL> <BANK#> <IP>
    
    \ FAR: compiles a "fat" header that contains SAMS BANK# and SAMS IP
    \  <LINK> 
    \  <PRECENDCE> 
    \  <NAME> 
    \  <CODEPAGE> \ extra field
    \  <SAMSPFA>  \ extra field 
    
    
    \ ;FAR compiles FAREXIT in SAMS memory, not in RAM to save space.
    
    \ Compile time check: ;FAR tests end of SAMS memory
    
    \ HISTORY
    \ Update Nov 2022: removed array of SAMS DP variables.
    \ - Each SAMS page uses last memory cell to hold its own DP.
    \ - Can now compile code to any SAMS page.
    \ - You must use <1st> <last> CODEPAGES to initialize SAMS code pages 
    \ Feb 2024: Pass codepage via Rstack to CMAP, cleanup & testing 
    
    
    NEEDS TRANSIENT FROM DSK1.TRANSIENT
    TRANSIENT
    NEEDS MOV,  FROM  DSK1.ASM9900
    
    PERMANENT
    NEEDS DUMP      FROM DSK1.TOOLS
    NEEDS SAMSINI   FROM DSK1.SAMSINI  \ common code for SAMS card
    
    HERE
    HEX
    \ **************[ CHANGE CSEG to your requirements ]******************
    
    HEX              3000 CONSTANT CSEG      \ CODE window in CPU RAM
    
    \ ********************************************************************
    
    \ SAMS memory addresses for code
              CSEG 0FFE + CONSTANT SAMSDP    \ variable at end of SAMS page
              CSEG 0F00 + CONSTANT SAMSEND   \ leave room for scroll buffer      
    4000 CSEG 0B RSHIFT + CONSTANT CREG      \ compute CSEG SAMS register
         CSEG 0C RSHIFT   CONSTANT PASSTHRU  \ default RAM page
    
    VARIABLE SAVHERE   \ temp holder for RAM Dictionary pointer
    VARIABLE BANK#     \ last SAMS bank# selected
    VARIABLE CPAGE     \ active code page used for compiling
    CREATE CODEPAGES 0 , 0 ,   \ valid CODEPAGES 
    
    HEX
    \ **LEAF SUB-ROUTINE**
    CREATE R>CMAP ( -- ) ( R: page# -- )
          R0 RPOP,
          R0 BANK# @@ MOV,   \ update the last bank used
          R0 SWPB,           \ swap bytes
          R12 1E00 LI,       \ set SAMS card CRU address
          0 SBO,             \ turn on the card
          R0 CREG @@ MOV,    \ map it
          0 SBZ,             \ turn off card
          RT,
    
    CODE CMAP  ( page# --) \ Forth word to map SAMS pages
          TOS RPUSH,    \ need parameter on Rstack
          R>CMAP @@ BL,  \ call it
          TOS POP,      \ refill TOS
          NEXT,
    ENDCODE
    
    \ run time executor for SAMS colon words.
    CREATE FARCOL
         IP RPUSH,
         W IP MOV,            \ IP = DATA cell of this word
         BANK# @@ RPUSH,      \ Save active code page
         *IP+ RPUSH,          \ get codepage to rstack, autoinc IP 
          R>CMAP @@ BL,       \ call R>CMAP (uses RSTACK parameter)
         *IP+ IP MOV,         \ get SAMSDP & set as IP, autoinc IP  
         NEXT,
    
    CODE FAREXIT             \ exit for SAMS word
         R>CMAP @@ BL,       \ restore old codepage & map it in
         IP RPOP,            \ Regular FORTH EXIT
         NEXT,
    ENDCODE
    
    \ \\\\\\\\\\\\\\\\ code words end  //////////////////
    
    \ change dictionary pointer to SAMS memory
    : SAMSDP! ( addr -- ) 
         HERE SAVHERE !     \ save FORTH here
         ( samsdp) DP !     \ set Forth DP to SAMSDP
    ;
    
    : FAR: ( -- ) \ special colon for words in FAR memory
         !CSP
         HEADER             \ compile Forth header with name
    \ RUNTIME ACTION 
         FARCOL ,           \ compile the new executor as CFA
    
    \ compile code page and SAMSDP for FARCOL to use at runtime 
         CPAGE @ DUP ,      \ compile codepage as the DATA field
         CMAP               \ map in the SAMS page to compile code
         SAMSDP @ DUP ,     \ compile SAMSDP 
         SAMSDP!            \ and switch dictionary to SAMSDP     
         HIDE 
         ]                  \ turn on the compiler
    ;
    
    : ;FAR ( -- ) \ end SAMS compilation. *NEW* compile time memory test
         POSTPONE FAREXIT    \ compiles at end of SAMS code
         POSTPONE [          \ turn compiler off
         REVEAL ?CSP
         HERE DUP SAMSDP !   \ update HERE for this bank, keep a copy
         SAVHERE @ DP !      \ restore DP to CPU RAM
         SAMSEND > 
         IF 
           CR ." >> Page " CPAGE @ DECIMAL . ." full"
           ABORT 
         THEN 
    ; IMMEDIATE
    
    : CODEPAGE ( bank# -- ) \ select SAMS page for compiling
      DUP CODEPAGES 2@  1+ WITHIN 0= ABORT" Not a code page" 
      CPAGE ! ; 
    
    HEX
    \ Initialize the SAMS memory that we want to use for CODE 
    \ ** USE THIS COMMAND ONLY ONCE OR MACHINE WILL CRASH ** 
    : CODEPAGES ( 1st last -- ) 
         2DUP CODEPAGES 2! 
         1+ SWAP 
         DO 
           I CODEPAGE
           I CMAP
         \  I . CSEG 1000 FF FILL \ for debugging ONLY 
           CSEG SAMSDP !     \ INIT the local CSEG DP variable to start of CSEG    
        LOOP  
        CODEPAGES @ DUP CODEPAGE CMAP  \ return to RAM memory page
    ;
    
    : >SAMS  CPAGE @ CMAP ;
    : >RAM   PASSTHRU CMAP ; 
    
    >RAM 
    : ;   
         BANK# @ PASSTHRU = 
         IF POSTPONE ;  
         ELSE POSTPONE ;FAR 
         THEN ; IMMEDIATE 
    
    : :  BANK# @ PASSTHRU = IF :   ELSE  FAR:  THEN ;
    
    
                                DETACH 
    HERE SWAP -
    DECIMAL CR . .( bytes)
    
    240 255 CODEPAGES \ 16 pages=64K of SAMS space 
    

     

     

    • Like 2
  6. 1 hour ago, Tursi said:

    Just use "C" cause that's apparently what people want to use, and I'm not planning to define anything myself. Classic99 will chew you out in the debug log but nobody ever looks there when there are issues either. ;)

    If it's any consolation, I took to looking at the log all the time, after about the 3rd time you chewed me out for not looking. :)

    It's hella handy. 🙏

    • Like 4
  7. 15 hours ago, dhe said:

    So here is my code fragment, it's a slight modification of the chime code in the E/A, using data (not shown) I pulled from The Intern for beep.

     

    PAT    EQU  $            PLAY ACCEPT TONE
           LI   R0,BUFFER    Load VDP RAM buffer address.
           LI   R1,ACEPTT    Pointer to the sound data.
           LI   R2,11        11 bytes to move to the VDP RAM buffer.
    *
           BLWP @VMBW        Move to the VDP RAM - play sound list from VDP RAM
    *
           LI R10,BUFFER     Load sound table address.
           MOV R10,@>83CC    Load pointer to the table.
           SOCB @H01,@>83FD  Set VDP flag.
           MOVB @H01,@>83CE  Trigger sound processing.
           LIMI 2            START PROCESSING
    
    LP2    MOVB @>83CE,@>83CE  Check if time is up
           JEQ  SCAN1          DONE PLAYING LEAVE
           JMP  LP2

     

      The books I've read say sound lists can be processed from VDP RAM or CPU RAM.  But, I've only came upon examples of processing a sound list from VDP RAM.

     

      Can someone point me to an example of processing a sound list from CPU RAM?

     

     

    I ASSUMMED that if you reset the VDP bit in >83FD  you could play lists from CPU RAM but I just tried it and it didn't work with my code.

    • Like 2
  8. Looking at my demos on GitHub I came across a program from the TI BASIC manual that

    I translated to Forth to demonstrate how it could be done for the Forth student. 

     

    The program puts random colored squares on the screen with a musical note. 

    The code to compute the note uses exponential floating point math.

    That's a lot of compute to just make a tone. :)

     

    In my first version, I just punted and made a sound with a random frequency

    but it's not a "legal" note from the western music chromatic scale. 

     

    Now that I am a member of a community orchestra I could not let that stand. ;)

     

    The code to compute a random note in BASIC is:

    160 N=INT(24*RND+1)
    170 FREQ=110*(2^(1/12))^N 

     

    It's not hard to generate N in Forth.

    : N   ( -- n)  24 RND 1+ ; 

     

    But without floating point I was scratching my head for a bit on how to do line 170. 

     

    Turns out 1/12= .0833333  repeated

    and 2^1/12 ~=1.059463 

     

    This means that given a frequency all we have to do is multiply by 1.059463 to raise the frequency by one semi-tone.

     

    For the non-music student every note on a piano keyboard is one semitone apart, if you press white and black keys in order. 

     

    So now we have a multiplier to move up note by note on the keyboard.

    That's something we can handle with integer math. 

     

    How?  With the Forth's magic */  operator. 

     

    Star-slash, as it is called, takes 3 arguments:  an input, a multiplier and a divisor.

    The multiplication in */  generates a 32 bit result so up to 4,294,967,296.

    This means it does not overflow easily.  The divisor is then used to "scale" that result back to the range we need for our little 16 bit integers. 

     

    So this simple word takes a note and bumps to the next semitone.

    At least that's the theory.

    : NOTE+   ( freq -- freq')   10595 10000 */ ;  

     

    When I compared the output of NOTE+ to a table of note frequencies this version of NOTE+ begins to run flat (notes are lower than correct) after the first octave. 

    This version is closer to the correct pitch but still not perfect.

    : NOTE+ ( freq -- ) 10570 10000 */ 1+ ;

     

    Then we need a way to get any semitone.  If we put NOTE+ in a loop and start at the lowest note TI-99 can play we get this. 

    : NOTE ( n -- freq) 110  SWAP 0 ?DO  NOTE+ LOOP  ;   
    


      However if you really want proper tuning it is probably better to use a table and look up the frequency like this: 

    Spoiler
    \ NOTES.FTH gives you a table of note frequencies     Feb 1 2024  B Fox 
    
    \ these are as accurate to pitch as TI-99 can produce
    CREATE NOTES[]   \ create a name for the data
    \ put the number into memory with the comma operator
    \ FREQ    MIDI Note 
    \ ----    ---- ----
      110 , \  45	A2   
      117 , \  46	A#2/Bb2
      123 , \  47	B2
      131 , \  48	C3
      139 , \  49	C#3/Db3
      147 , \  50	D3
      156 , \  51	D#3/Eb3
      165 , \  52	E3
      175 , \  53	F3
      185 , \  54	F#3/Gb3
      196 , \  55	G3
      208 , \  56	G#3/Ab3
      220 , \  57	A3
      233 , \  58	A#3/Bb3
      247 , \  59	B3
      262 , \  60	C4 (middle C)
      277 , \  61	C#4/Db4
      294 , \  62	D4
      311 , \  63	D#4/Eb4
      330 , \  64	E4
      349 , \  65	F4
      370 , \  66	F#4/Gb4
      392 , \  67	G4
      415 , \  68	G#4/Ab4
      440 , \  69	A4 concert pitch
      466 , \  70	A#4/Bb4
      494 , \  71	B4
      523 , \  72	C5
      554 , \  73	C#5/Db5
      587 , \  74	D5
      622 , \  75	D#5/Eb5
      659 , \  76	E5
      698 , \  77	F5
      740 , \  78	F#5/Gb5
      784 , \  79	G5
      831 , \  80	G#5/Ab5
      880 , \  81	A5
      932 , \  82	A#5/Bb5
      988 , \  83	B5
      1047 , \  84	C6
      1109 , \  85	C#6/Db6
      1175 , \  86	D6
      1245 , \  87	D#6/Eb6
      1319 , \  88	E6
      1397 , \  89	F6
      1480 , \  90	F#6/Gb6
      1568 , \  91	G6
      1661 , \  92	G#6/Ab6
      1760 , \  93	A6
      1865 , \  94	A#6/Bb6
      1976 , \  95	B6
      2093 , \  96	C7
      2217 , \  97	C#7/Db7
      2349 , \  98	D7
      2489 , \  99	D#7/Eb7
      2637 , \ 100	E7
      2794 , \ 101	F7
      2960 , \ 102	F#7/Gb7
      3136 , \ 103	G7
      3322 , \ 104	G#7/Ab7
      3520 , \ 105	A7
      3729 , \ 106	A#7/Bb7
      3951 , \ 107	B7
      4186 , \ 108	C8
    
    \ make word that indexes into the table and fetches the frequency
    : ]NOTE ( n -- freq) CELLS NOTES[] +  @ ;
    

     

     

    The final program is here: 

    CAMEL99-ITC/DEMO/RNDCOLOR.FTH at master · bfox9900/CAMEL99-ITC · GitHub

     

     

    • Like 3
  9. 51 minutes ago, 9640News said:

    I'm a little bit bummed this evening.  Ordered a Raspberry PI 5 on December 2nd.  It shipped two weeks ago from Canada and arrived today.  Last night, a stray dog showed up at the house.  This afternoon, the UPS delivered the package to my doorstep.  The dog got the package, and I found parts of the kit scattered near my front porch.  Two HDMI cables destoyed and the cooling fan destroyed.  I have spare cables I can use for HDMI, however the cooling fan was crunched up and was modified slightly to work with the new PI-5 box.

     

    I should have a new cooling fan Friday.

     

    Fortunately, the 128 GB card, heatsink, case, PI5, and power supply did not get chewed up.

     

    Trying to get the pound to get the dog now before I take other measures.

    .22 magnum?

    • Haha 3
  10. I am doing some New Year cleanup on my Git repository Demos. 

    I had made an X,Y reversal in the sprite library which I fixed last year but that meant that sprite demos didn't work. 

     

    I found this one and thought I would use it to demonstrate how you don't get good Forth programs

    if you try to translate directly from BASIC. 

    It can be done but it's ugly and hard as hell to debug.

     

    Here is the BASIC program. 

     1 ! Smart Programming Guide for Sprites
     2 !      by Craig Miller
     3 ! (c) 1983 by Miller Graphics
     100 CALL CLEAR
     110 CALL SCREEN(2)
     120 CALL CHAR(46,"0000001818")
     130 CALL SPRITE(#2,94,16,180,1,0,5)
     140 FOR N=0 TO 25
     150     X=RND*192+1
     160     Y=RND*255+1
     170     CALL SPRITE(#3,65+N,16,Y/2+1,X+1)
     180     CALL SOUND(-60,660,8)
     190     CALL POSITION(#3,Y,X,#2,R,C)
     200     CALL SPRITE(#1,46,16,R,C,(Y-R)*.49,(X-C)*.49)
     210     CALL SOUND(476,-3,14)
     220     CALL SOUND(120,110,6)
     230     CALL DELSPRITE(#1)
     240     CALL PATTERN(#3,35)
     250     CALL SOUND(100,220,6)
     260 NEXT N
     270 GOTO 140

     

    Here is a more literal translation to Forth. (Camel99 specific ) It has a few changes like named sprites and named colors.

    But the main program loop is full of stuff like the BASIC version. 

    Spoiler
    NEEDS .S     FROM DSK1.TOOLS
    NEEDS MOTION FROM DSK1.AUTOMOTION
    NEEDS RND    FROM DSK1.RANDOM
    NEEDS DB     FROM DSK1.SOUND
    
    VARIABLE X   VARIABLE Y
    VARIABLE RR  VARIABLE CC
    
    CREATE ABULLET HEX 0000 , 0018 , 1800 , 0000 ,
    
    : DELSPRITE ( spr# -- ) 0 SWAP SP.PAT VC! ;
    
    DECIMAL
    \ name sprites and colors for convenience
     1 CONSTANT AMMO    2 CONSTANT TURRET   3 CONSTANT TARGET
     2 CONSTANT BLACK   5 CONSTANT BLUE    16 CONSTANT WHITE
    
    \ functions to assist translation from BASIC 
    : (Y-RR)/2  ( -- n)  Y @ RR @ -  2/ ;
    : (X-CC)/2  ( -- n)  X @ CC @ -  2/ ;
    : SOUND1   ( t Hz db -- ) GEN1  DB  HZ  MS  MUTE  ;
    : ?BREAK   ?TERMINAL IF  STOPMOTION CR ." BREAK"  ABORT  THEN ;
    
    
    : RUN
    ( 100) CLEAR
    ( 110) BLUE SCREEN  10 0 AT-XY ." Camel99 Forth"
    ( 120) ABULLET [CHAR] . CHARDEF
    ( 130) [CHAR] ^ WHITE 1 180 TURRET SPRITE   
           5 0 TURRET MOTION
           AUTOMOTION
    
    ( 140) BEGIN 
            25 0 DO
    ( 150)    192 RND 1+ Y !
    ( 160)    255 RND 1+ X !
    ( 170)    [CHAR] A I +  WHITE   X @ 1+  Y @ 2/   TARGET SPRITE
    ( 180)    660 8 50 SOUND1
    ( 190)    TARGET POSITION X ! Y !    TURRET POSITION  CC !  RR ! 
    ( 200)    [CHAR] . WHITE RR @ CC @  AMMO SPRITE  
              (Y-RR)/2 (X-CC)/2 AMMO MOTION
    ( 210)    2 NOISE -14 DB 430 MS MUTE
    ( 220)    120 110 -6 SOUND1 
    ( 230)    AMMO DELSPRITE
    ( 240)    [CHAR] # 3 PATTERN
    ( 250)    100 220 -6 SOUND1
              ?BREAK 
    ( 260)   LOOP
    ( 270) AGAIN ;
    
    

     

     

    And here is something that is more Forth style.  Notice it has NO  variables. 

    Once you know that all the sprite information is stored in VDP RAM already

    and that the sprite functions just read and write that memory then variables

    become duplicated data storage. Pointless.

     

    For example to create sprite #3 in the same position as sprite #2,  we just

    replace the X,Y parameters of the SPRITE creator with the POSITION function. :) 

     

    \ ascii    color    x  y       Spr#
     [CHAR] .   15    2 POSITION   3  SPRITE  

     

    Random number example. 

    If we know we will need random x and y values we don't need variables. 

    We just put them on the data stack when we need them. 

    \ return random coordinates 
    : RNDX  ( -- x) 255 RND 1+ ;
    : RNDY  ( -- y) 192 RND 1+ ;
    

     

    So here is the end result where we have factored out parts of the original program in to easier to debug pieces. 

    This would make BASIC more complicated but allows Forth programs to be easier to understand IMHO. 

    Spoiler
    \ Camel99 kernel is bare-bones. 
    \ Extras must be compiled into system
    NEEDS .S     FROM DSK1.TOOLS
    NEEDS MOTION FROM DSK1.AUTOMOTION
    NEEDS RND    FROM DSK1.RANDOM
    NEEDS DB     FROM DSK1.SOUND
    
    \ character definition for the bullet 
    CREATE ABULLET HEX 0000 , 0018 , 1800 , 0000 ,
    
    DECIMAL
    \ name the sprites 
     1 CONSTANT AMMO    2 CONSTANT TURRET   3 CONSTANT TARGET
    
    \ Name the colors
     2 CONSTANT BLACK   5 CONSTANT BLUE    16 CONSTANT WHITE
    
    \ words to make it more like BASIC 
    : SOUND1   ( t Hz db -- ) GEN1  DB  HZ  MS  MUTE ;
    : ?BREAK   ?TERMINAL IF  STOPMOTION CR ." BREAK"  ABORT  THEN ;
    
    \ return random coordinates 
    : RNDX  ( -- x) 255 RND 1+ ;
    : RNDY  ( -- y) 192 RND 1+ ;
    
    : TURRET-SPRITE 
    \    ascii    colr x  y   spr# 
        [CHAR] ^ WHITE 1 180 TURRET SPRITE   
        5 0 TURRET MOTION ;
    
    : TARGET-SPRITE ( char --) 
    \   colr     x       y        spr# 
        WHITE  RNDX 1+  RNDY 2/  TARGET SPRITE ;    
    
    \ function computes motion vector between 2 SPRITES x,y
    : DELTA ( x y x2 y2  -- x' y')  
            ROT  - 2/  >R   \ delta Y pushed to Rstack 
            SWAP - 2/       \ delta X    
            R> ;            \ bring back delta Y  
    
    : DELSPRITE ( spr# -- ) 0 SWAP SP.PAT VC! ;
    
    : SHOOT 
    \ next line sets the motion vector for the AMMO sprite
    \ by reading the sprite positions and computing the delta
        TURRET POSITION  TARGET POSITION DELTA  AMMO MOTION
    
    \ generate noise using sound chip API
        2 NOISE -14 DB 430 MS MUTE
    
        120 110 -6 SOUND1 
        AMMO DELSPRITE
        [CHAR] # TARGET PATTERN
        100 220 -6 SOUND1    
    ;
    
    : RUN 
        CLEAR  
        BLUE SCREEN 
        10 0 AT-XY ." Camel99 Forth"
        ABULLET [CHAR] . CHARDEF
        TURRET-SPRITE 
        AUTOMOTION
        BEGIN 
            25 0 
            DO
            \ put target sprite on the screen with a sound     
                [CHAR] A  I +  TARGET-SPRITE 
                50 660 8 SOUND1
    
            \ put the AMMO sprite at the turret position 
                [CHAR] . WHITE  TURRET POSITION AMMO SPRITE  
                SHOOT 
               
                ?BREAK 
            LOOP
        AGAIN ;
    

     

     

    • Like 3
  11. 2 hours ago, InsaneMultitasker said:

    Well now, this brings back a few unsavory support-related memories I had thought were sufficiently buried within the depths of my subconscious.  Oh, dear.

    ARGH!  me too.   News reporter terminal keyboards. YUUUk! 

  12. 5 minutes ago, Lee Stewart said:

     

    I posted the code in a spoiler 6 posts back.

     

    ...lee

    I missed that spoiler. Wow! That is really neat.  Good coding by you.

    I don't fully grok the method yet but that's pretty slick.

     

    Would you say the c code is doing the method in the Forth below but non-recursively ?

    : USQRT ( u -- u1 )
       DUP 2 U< IF EXIT THEN
       DUP >R 2 RSHIFT RECURSE
       2*                ( -- u sm )
       1+ DUP            ( -- u la la )
       DUP *             ( -- u la la^2 )
       R> U> IF 1- THEN  ( -- u1 )
    ;

     

  13. 8 minutes ago, Lee Stewart said:

     

    One advantage my UDSQRT has over these is that it operates on an unsigned double. The maximum useful square is 4,294,836,225 (>FFFE 0001), the square root of which is 65535 (>FFFF). Higher squares result in the same root, which for about half of them is only off by 1. The other half are correct.

     

    ...lee

    Indeed.  Is it all ALC? 

    I am tempted to try and make one of these 16 bit Forth versions take an Unsigned double. They will be slow but at least more useful. 

     

  14. OH I do go down rabbit holes.

    While doing some housecleaning I found a failed attempt to make timers.

    I had to make it work. 

     

    So these timers use the ISR to run a master 32 bit counter. 

    When you create a timer is records 2 things:

    1. The number of seconds it will run before expiring
    2. The value of the counter + the number of seconds 

    When you call the timer by name, it compares the master counter to the number it has stored inside of itself.

    If the master counter is greater than it returns TRUE, meaning the timer expired. 

     

     

    The advantage here is that you do RESET <TIMER_name> and then your program can do whatever is needed and test the timer when it can.

    The overhead of the IST is almost nothing since it is just 3 instructions max + return. 

     

    Here is an example program:

    \ test
    4 TIMER: Q 
    
    : TEST 
        PAGE 
        RESET Q 
        BEGIN 
          BEGIN Q UNTIL           \ wait until  Q expires 
          CR ." 4 sec. elapsed " 
          CR
          RESET Q  
          ?TERMINAL               \ test for break key 
        UNTIL       
    ;
    
    

     

    OK now I can get on with something important. 

    Spoiler
    \ ISR BASED TIMERS  
    
    INCLUDE DSK1.LOWTOOLS  \ assembler, dump, Vdump, .S , elapse 
    
    HEX 
    : INSTALL  ( isr-addr -- ) 83C4 ! ; 
    
    : STOPTIMER  0 INSTALL ;
     
      STOPTIMER  
    
    \ 32 bit variable holds the master clock time
    CREATE TIME  0 , 0 ,
    
    \ ISR increments the 32bit variable every 16mS
    HEX
    CODE TIME++ ( -- ) 
      TIME CELL+ @@ INC,
      OC IF,
          TIME @@ INC, 
      ENDIF,
      RT,
    ENDCODE
    
    \ start/stop the ISR timer 
    : RUNTIMER   ['] TIME++ INSTALL ;
    
    \ debug words 
    : TIME@   TIME 2@ ;
    : .TIME   TIME@ UD. ;
    
    : DU<  ( d d -- ?) ROT U> IF 2DROP -1  ELSE U<  THEN ;
    
    \ reset a timer's using it's data field address 
    : (TRESET) ( addr -- )
        DUP  >R             \ dup timer base address & Rpush 
        @ TIME@ ROT M+       \ read the timers' delay, add to TIME 
        R> CELL+ 2!         \ store new time in the timer 
    ;
    
    DECIMAL 
    : SECONDS  ( n --- n') 1000 16 */  ; \ convert seconds to ticks 
    
    : TIMER: ( n )
        CREATE  
            SECONDS DUP ,  \ compile the time delay in ticks 
            TIME@ ROT M+   \ add delay to current time 
            , ,            \ compile the double into memory 
    
        DOES> ( -- ?)      \ return true if timer expired 
            CELL+ 2@  TIME@  DU< ; \ compare timer to master
    
    
    \ reset a timer by name. state smart
    : RESET ( timer )  
      '  >BODY 
      STATE @ 
      IF POSTPONE LITERAL  POSTPONE (TRESET) 
      ELSE  (TRESET)
      THEN ; IMMEDIATE  
    
    \ reset master clock to 0 
    : MASTER-RESET ( -- ) 0 S>D TIME 2! ;
    
    \ disable the ISR before resarting Forth 
    : COLD     STOPTIMER COLD ;
    
    RUNTIMER 
    

     

     

    • Like 2
  15. I went looking in my collection and I found these two unsigned square root functions.

     

    Interesting, but they would still not have the range you need. 

    \ recursive version by Gerry Jackson comp.lang.forth 
    : USQRT ( u -- u1 )
       DUP 2 U< IF EXIT THEN
       DUP >R 2 RSHIFT RECURSE
       2*                ( -- u sm )
       1+ DUP            ( -- u la la )
       DUP *             ( -- u la la^2 )
       R> U> IF 1- THEN  ( -- u1 )
    ;
         
    \ Dr. Ting's version 
    : SQRT-TING ( n -- root )
       65025 OVER U< ( largest square it can handle)
       IF DROP 255 EXIT THEN ( safety exit )
       >R ( save sqaure )
       1 1 ( initial square and root )
       BEGIN ( set n1 as the limit )
          OVER R@ U< ( next square )
       WHILE
          DUP CELLS 1+ ( n*n+2n+1 )
          ROT + SWAP
          1+ ( n+1 )
       REPEAT
       NIP
       R> DROP
    ;
    
    

     

    • Like 3
  16. I was surprised how sound list are pretty easy once the magic addresses are discovered. 

    I was able to start the whole thing with just Forth. I just needed to add 0LIMI and 2LIMI to let Forth do the interrupt control.

     

    Below is how I play sound lists in VDP RAM.  

    Maybe you can make some use of this to write it in Assembler with the comments I added,.

     

     83C2 EQU AMSQ      \ interrupt DISABLE bits
    \ AMSQ bit meaning:
    \ 80 all interrupts disabled
    \ 40 motion disabled
    \ 20 Sound disabled
    \ 10 quit key disabled
    

     

    This code will play a VDP sound list that is "MOVed" into 83CC

     0LIMI                     \ interrupts off
     
     83CC !                    \ store the Vdp address of your sound list in >83CC
     AMSQ C@  5 AND AMSQ C!    \ Read the byte at AMSQ address, AND the value with 5 
     01 83CE C!                \ store 1 in the byte at >83CE. Triggers sound list processing
     83FD C@  01 OR 83FD C!    \ set bit 1 at >83FD makes "VDP RAM the "source" of a sound list 
     
     2LIMI                     \ interrupts on starts the sound
    

     

    • Like 3
  17. 50 minutes ago, Lee Stewart said:

     

    * Mute all four sound generators
    *   BL @MUTE to execute this routine
    *
    SOUND  EQU  >8400
    MUTE   LI   R0,>9F00       byte to mute tone generator 0
           LI   R1,4           count for 4 generators
    MUTE1  MOVB R0,@SOUND      mute next generator
           AI   R0,>2000       inc to next generator
           DEC  R1             done?
           JNE  MUTE1          do another if not
           RT                  return to caller

     

    ...lee

    So does the GPLLNK beep code never turn off the sound on its own?

     

  18. I am going to make a guess.

    From my understanding the sound processing code is running on the interrupt. So code is executed every 16mS. 

    • GPLLNK sets up to make a sound. 
    • you enable interrupts
    • the sound producing code turns on the oscillator and probably returns because it is going to do a time delay for the sound duration.
    • When the interrupt returns to your code it hits LIMI 0.
    • So now the rest of the sound generating code never runs because interrupts are off, which includes the delay code and the code to turn off the sound. 

    So either a put in a delay before LIMI 0 or do some other stuff before invoking LIMI 0 and see what happens.

  19. 7 hours ago, Vorticon said:

    It was surprisingly arduous to make the date entry validation idiot-proof

     

    "It is impossible to make anything idiot proof, because idiots are too ingenious"

     

                                                                                          Murphy's Law of Engineering

     

    • Haha 4
×
×
  • Create New...