Jump to content

TheBF

+AtariAge Subscriber
  • Content Count

    2,737
  • Joined

  • Last visited

Posts posted by TheBF


  1. 2 hours ago, GDMike said:

    Naaa. I'd have to build a loader, like a DF80 reader, and then setup the map and place the file read into SAMS manually at boot.

    Don't know if this helps but I love disk functions 5 and 6 for this kind of thing.

    They just blast in and out as long as you don't need more than 8K which you don't.

    Here it is Forth. I can answer any questions.

     

    But really you just set up the PAB and hit 6 to save and 5 to load.

     

    Differences from TF below: 

    VC! writes one byte.

    V!  writes 2bytes (one CELL) 

     

    ior means I/O response (error number) 

    HEX
    \ PRE-FAB file access mode selectors for default file binary type
    0B CONSTANT W/O100  \ WRITE ONLY, binary, relative, fixed 100
    0D CONSTANT R/O100  \ READ ONLY,  binary, relative, fixed 100
    \ 13 CONSTANT PROG
    
    : NEWPAB   (  file$ len VDPaddr #bytes mode -- )
               -30 ^PAB +!         \ create new pab in VDP RAM with NO buffer
               [PAB 30 0 VFILL     \ erase PAB and file name
             0 [PAB RECLEN] VC!    \ set reclen (0 means >100 (256) bytes)
             \ pulls params from the stack to init the PAB
               [PAB FLG] VC!       \ set file access mode byte
               [PAB REC#]  V!      \ set #bytes to save (integer)
               [PAB FBUFF] V!      \ set where the file will load VDP Ram
               [PAB FNAME] VPLACE  \ set file name
    ;
    
    : SAVE-FILE ( file$ len VDPaddr #bytes -- ior)
           W/O100 NEWPAB  6 FILEOP  30 ^PAB +! ;
    
    : LOAD-FILE ( file$ len VDPaddr size -- ior)
           R/O100 NEWPAB  5 FILEOP  30 ^PAB +! ;
    
    

     

    • Like 1

  2. 6 minutes ago, GDMike said:

    What I had in mind was this...

    Step 1. Gather my routines and get them altogether to assemble using AORG >3000 as Lee suggested and save them out as dF80.

    I can load this at program boot, START

     

    Step 2. And find each routine's beginning address. Easy enough.

    (Each routine ENDS with a  KSCAN and Branch out to my mapper procedure at a high address, somewhere around >E000).

    And my program can call any routine address with a B @ >3456 or whatever and already mapped and ready to load the routine from the bank which is already predetermined.

    as Lee also suggested, try cramming as many routines as possible into that 4K space, and maybe I can get by with a low load Time.

    but, in my case, TIpi loads fast enough and I don't forsee a long wait for the ONE time load(Even in steps of records).

    ????

     

    So the E/A loader would load the code block as object code?

    If you have the way to do it, saving the data as a binary program, or converting the object to a binary program, would mean FOXIT could load the 4K block itself when it starts in about .5 seconds. 

     

    Wouldn't that be  BL @ >3456   ? 

    • Like 1

  3. 2 hours ago, Lee Stewart said:

     

    I think it should be separate EA/5 program files of 4 KiB max each (essentially overlays) that are each AORGed at >3000 (your SAMS window), which can be patched together into one DF128 file for later loading into SAMS banks, 4 KiB at a time (with one call each 4 KiB), via Level-2 Subprogram >014. You could also load to SAMS via Level-3 READs, but that would require reading 32 records, one at a time.

     

    ...lee

    Since I never work in conventional assembler, I am curious if it would be worthwhile to give the 4K overlays some kind of jump table at the top so you could call the code by number?

    Of course that means you need a standard calling sequence for each one too so maybe too complicated. (?)

     

    • Like 2

  4. 7 hours ago, Tursi said:

    Classic99 is fairly generous when it's loading, check the debug log after loading to see if it threw any warnings. The real TI of course doesn't care and just does whatever it's told, whether valid or not. You could also post a file that complains and we can check the headers for you.

     

    Thank you.  So far it is every file generated by my DOS cross-compiler, but none that I save from Camel99 Forth.

    To be fair the code is entirely different. The DOS version is clunky from when I was just getting back to this stuff. 

     

    Here is one the JS99er complains about.

    Ignore the error on startup. It's just looking for the START file that is like autoexec.

     

     

    CAMEL268.zip

    • Like 1

  5. 21 minutes ago, TheBF said:

    I think I might have found an earlier version of JS99er. It defaulted to TI BASIC and Editor/Assembler in the menu.

    That's the one that gave me the "too short" message.

     

    I have not learned how to add cartridges to JS99er to use it for my purposes. 

    I will look for some docs. 

    So now that I know how to use the emulator a bit I have found that programs I create with Camel99 Forth like theMatrix demo load fine on JS99ER.

    The Camel99 program that is cross-compile with my DOS compiler are called "too short".

    So I will be spending some time learning what I have wrong in my cross-compiler. :) 

    Interesting that TI-99 and Classic99 load the files. 

    I suspect there is something wrong with the cross-compiler as it was my first journey back into TI-99 space.

     


  6. 1 hour ago, Asmusr said:

    Where does it say that?

    The first version doesn't work for me but the second does.

    BTW there's no need to use a disk image, you can just click 'Load disk' and select the zip file.

    I think I might have found an earlier version of JS99er. It defaulted to TI BASIC and Editor/Assembler in the menu.

    That's the one that gave me the "too short" message.

     

    I have not learned how to add cartridges to JS99er to use it for my purposes. 

    I will look for some docs. 


  7. 6 hours ago, retroclouds said:

    Give TI Basic some love…

     

    While working on integrating Stevie with TI Basic, I started appreciating TI Basic a lot.

    Back in the days I had Extended Basic so didn’t care about TI Basic much.

    Although the very first baby steps I did was in TI Basic, because I only got the TI Extended Basic module a few months later.

     

    Anyway, we all know how much powerfull TI Extended Basic is and that it has a lot of advantages over TI Basic.

     

    However, in this topic I ask you:

     

    1) What are the (technical) benefits of using TI Basic compared to Extended Basic?

    2) What are the most critical features missing in TI Basic?

     

    Reason for asking is because I’m working on improving the TI Basic experience in combination with Stevie (full-screen editor)

     

    As far as (2) is concerned, I’ll kick it off with: peek, poke (load), peekv, pokev, load, hex

    To me the full meal deal would be an IDE, something like DOS Turbo C/Pascal , built with Stevie that lets you edit, compile,and run TI-BASIC programs.

    I have no idea if such a thing is realistic but perhaps with a liberal use of overlays it could be done.

    • Like 3

  8. 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 [email protected] 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


  9. 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

     

     

    THEMATRIX.ZIP

    • Like 3

  10. 3 hours ago, speccery said:

    I use the ?: notation all the time, here is the implementation of SGN function in the Basic interpreter of the StrangeCart:

          case TOK_SGN:
            line++;
            expect(TOK_OPEN_PARENTHESIS);
            a = eval();
            expect(TOK_CLOSE_PARENTHESIS);
            return a < 0 ? -1 : (a ==0 ? 0 : 1);

    I start to feel that I really need to add it to the Basic. Then for example factorials (the standard example of recursive functions) could be computed this way:

    DEF FACT(N)= N>1 ? N*FACT(N-1) : 1

     

    I realize now that this is sometimes called the "Elvis" operator.  Think emoticon with hair   ?:-)   

     

    So I am still curious is it just a syntax convenience or does it generate different code?

    • Haha 3

  11. 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$ ;
    
    : ##     [email protected] >R 0 <#   # #  #>   TYPE  R> BASE ! ;
    : ####   [email protected] >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.  

     

     

    LONGDATE.png

    • Like 4
    • Thanks 1

  12. 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! :) 

     


  13. 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,
    
    : ##     [email protected] >R 0 <#   # #  #> TYPE    R> BASE ! ;
    : ####   [email protected] >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> ## ;
    

     

     

     

     

     

    • Like 4

  14. 1 minute ago, HOME AUTOMATION said:

    Maybe you're thinking of me... As far as I know, that's the way to go!;-)

    I concur it's the only way to *go.  Sadly, I was not thinking of you. :( 

    I saw it first with the Billy Ball Demo that @Retrospect did.

    Very solid looking code.

     

    *Unless you have threads. :) 

    • Like 3

  15. 1 hour ago, mizapf said:

    Something like this from my recent SCSI emulation - I use it several times in each file.

     

    line_state whtscsi_pld_device::scsi_cs()
    {
        return (busen()
            && ((m_board->m_address & 0x0fe0)==0x0fe0)
            && (((m_board->m_address & 0x1000)!=0) == m_bank_swapped)
            && (((m_board->m_address & 1)==0) || m_word_transfer))? ASSERT_LINE : CLEAR_LINE;
    }

    I think idea was pioneered in LISP.  LISP - Cond Construct (tutorialspoint.com)

    Does the C version generate better code than  if  else   ?  

    • Like 1

  16. 4 hours ago, Retrospect said:

    It's just a method I developed.  During the last couple of games I altered my coding style.  Now that I'm doing it this way I can see that for all my previous games I was doing it wrong.  lol

    It that the format that I saw where you use lots of narrow focused sub-routines and a big main game loop that just calls them as needed?

    • Like 2

  17. I asked for some examples of large Forth projects on comp.lang.forth.

     

    This one came in that shows Forth working in the layer cake of languages:

     

    https://ojs.library.queensu.ca/index.php/PCEEA/article/view/4004

     

    From a quick read:

    1. Forth was used to write the CNC interpreter.

    2. C was used to write the Forth system called PFE.

    3. Python was used to write the GUI

     

    So using each tool to its strength.  Nice.

    • Like 1

  18. It could take me hours as well because I would have to work up the higher level words to create the calendar etc. and I am not that smart. 

     

    Forth is actually a macro assembler for the Forth VM so low level.  Chuck Moore is a fanatic about simplicity. He doesn't believe in general solutions because "I have never seen the general problem" :) 

    So you do have to build more foundation yourself than C.  The commercial systems come with a pile of library code. Forth Inc has a SQL library.

    Most old hands have their own personal library that they customize as needed.  

     

    ---------------

    Let me see what happens if "spitball" your questions: (this is dangerous) :) 

     

    A calendar event is a string (event name), date/time (year, month, day, hour, minute), a duration (minutes), a "repeating flag", and an end date.

    For simplicity, if repeating flag = 0, no repeat, flag = 1, every day, flag = 2, every week. the end date (year, month, day) is ignored if 

    e.g., a simple 30 minute non-repeating event:

     

    I would keep the records in a BLOCK file which makes the data look like virtual memory.

    For what you show here in small system like TI-99 I would limit the record size to 32 bytes so 32 records per 1K file block.

    With that record size could fit 366 days for a leap year, with 15 events per day max on a 180K DSSD floppy disk. :) 

    On a modern system that could be much bigger.

    \ returns the address of the record in virtual memory
    : ]RECORD  ( rec# -- addr) B/REC *  1024 /MOD BLOCK + ; 
    
    : [REC   ACTIVE @ ]RECORD ;

     

    My first problem is that every Forth system handles strings differently, so let's drop that problem for now.

    This can be true but the ANS has made some progress in making the primitives more standard. 

    All the commercial systems provide libraries. So too, all the TI-99 Forths. 

            

    Problem 2, how do you get fields?  In C, this is straightforward:

    ANS Forth has structs

    I my library I defined CELL: and CHAR: using the primitive word +FIELD. 

    Even here Forth gives you primitives. You make the rest. 

    \ We can access the fields using ANS Forth structures
     0   ( accumulator ) 
     9 CHARS: EVENT]
         CELL: YEAR]
         CHAR: MONTH]
         CHAR: DAY]
         CHAR: HOUR]
         CHAR: MINS]
         CELL: DURATION]  ( mins)
         CHAR: FLAG]
         CELL: YEAR2]
         CHAR: MONTH2]
         CHAR: DAY2]  
         CONSTANT REC-SIZE
    
    
    

     

    So with the struct words and [REC  we can access a disk records like this:

     

    5 ACTIVE !     ( sets the active record) 

    [REC YEAR] @ .   ( fetch and print integer)

    [REC FLAG] [email protected] .  ( fetch byte and print it) 

     

     

    Since you have defined your event like that I would be temped to make the code look like that.  These lines put data to disk records.  :) 

    0 REC# '( " E1"  2021,11,23,16,30,15,0,0,0,0 )EVENT
    1 REC# '( " E2"  2021, 11, 23, 16, 30, 15, 1, 2021, 11, 27 )EVENT   
    2 REC# '( " E3"  2021, 11, 23, 16, 30, 15, 2, 2021, 12, 15 )EVENT  
    3 REC# '( " E4"  2021,11,23,16,30,15,0,0,0,0 )EVENT
    4 REC# '( " E5"  2021, 11, 23, 16, 30, 15, 1, 2021, 11, 27 )EVENT   
    5 REC# '( " E6"  2021, 11, 23, 16, 30, 15, 2, 2021, 12, 15 )EVENT  
    6 REC# '( " E7"  2021,11,23,16,30,15,0,0,0,0 )EVENT
    7 REC# '( " E8"  2021, 11, 23, 16, 30, 15, 1, 2021, 11, 27 )EVENT   
    8 REC# '( " E9"  2021, 11, 23, 16, 30, 15, 2, 2021, 12, 15 )EVENT  

     

     

    I know exactly how I'd implement this in C, or Javascript, or Python, but Forth?

    To be fair that's a bit like saying "I know exactly how to write that in French, or German, or Dutch but Russian?"

     

    Plus, consider the fact that we need to compare dates more than once, so the stack will always have the target date on the bottom, so you need to do something like 3DUP before you consume a date, because you need to preserve the date.

    If you are doing that then something is wrong.  You should never be accessing deeper that 3 items 4 absolute MAX into the data stack.  Factor that sh*t out.  

    If you really have a complex problem, then ANS Forth now has locals on a stack frame like C, but there is performance hit versus doing it without stack frames.


    I have not written it yet but I would do:  [email protected] >SECONDS  returning a long integer value (32bit on TI-99) 

    With that method you will just read the field from each record and reduce each one to seconds then do 32bit compare  (D=)  and that's it. 

    There would 2 items per double on the stack but because you use 32bit operators you don't need to know that.

     

    In Forth, I'm not at all sure how I'd write this in a way I could read it. I definitely, for example, need a Forth FOR loop because I need to access "I" all the time

    Forth has the DO LOOP  with an index called I , (J , K) for nested loops.

     

     

    So all that to say here is a very simple database that writes to disk for your data.  

    I am an amateur here. I left engineering work over 25 years ago and worked on the business side of things so I am re-learning this stuff for my own amusement. 

    And... trying to remember all the crap in the libraries that I wrote over the last 2 years. :) 

     

    However you can see that you don't actually write Forth like C or any other language for that matter.

    You can... but you will hate it. :) 

    Maybe that's why so many people do? :)))

     

    Spoiler
    \ Example calendar data base
    
    INCLUDE DSK1.TOOLS
    INCLUDE DSK1.BLOCKS
    INCLUDE DSK1.STRUC12
    INCLUDE DSK1.UDOTR
    INCLUDE DSK1.CASE
    
    DECIMAL
    \ 30 S" DSK5.CALENDAR" MAKE-BLOCKS
    
    S" DSK5.CALENDAR" OPEN-BLOCKS 
    
    32 CONSTANT B/REC 
    VARIABLE ACTIVE 
    
    : REC#  ( n -- ) ACTIVE ! ;
    
    \ returns the address of the record in virtual memory
    : RECORD  ( rec# -- addr) B/REC *  1024 /MOD BLOCK + ; 
    
    : [REC   ACTIVE @ RECORD ; \ use with words that end with ']'
    
    \ We can access the fields using ANS Forth structures
     0   ( accumulator ) 
     9 CHARS: EVENT]
         CELL: YEAR]
         CHAR: MONTH]
         CHAR: DAY]
         CHAR: HOUR]
         CHAR: MINS]
         CELL: DURATION]  ( mins)
         CHAR: FLAG]
         CELL: YEAR2]
         CHAR: MONTH2]
         CHAR: DAY2]  
         CONSTANT REC-SIZE
    
    
    : " ( -- addr len) [CHAR] " PARSE-WORD ;
    : PARSE-INT   ( -- n )   [CHAR] , PARSE-WORD  EVALUATE ;
    
    HEX
    : PARSE-BYTE  ( -- c ) 
      [CHAR] ,  PARSE-WORD  EVALUATE DUP FF00 AND ABORT" Bad byte value"  ;
    
    DECIMAL
    : ?EVENT  ( addr len -- addr len)
              DEPTH 2 < ABORT" Quoted string expected"
              DUP 9 > ABORT" String too long"
    ;
    
    : '(   
    
       [CHAR] " PARSE-WORD  [REC EVENT] PLACE
        PARSE-INT  [REC YEAR] !
        PARSE-BYTE [REC MONTH] C!
        PARSE-BYTE [REC DAY] C!
    
        PARSE-BYTE [REC HOUR] C!
        PARSE-BYTE [REC MINS] C!
        PARSE-BYTE [REC DURATION] !
    
        PARSE-BYTE [REC FLAG] C!
    
        PARSE-INT [REC YEAR2] !
        PARSE-BYTE [REC MONTH2] C!
        PARSE-BYTE [REC DAY2] C!
    ;
    
    : )EVENT
       UPDATE FLUSH   \ mark block updated and flush to disk
    ;  \ advance to next record
    
    : [email protected]  ( -- day month year)
       [REC DAY] [email protected]  [REC MONTH] [email protected]  [REC YEAR] @  ;
    
    : [email protected]   ( -- day month year)
       [REC DAY2] [email protected]  [REC MONTH2] [email protected]  [REC YEAR2] @  ;
    
    : [email protected]  ( --   mins hr ) [REC MINS] [email protected]   [REC HOUR] [email protected]  ;
    
    
    : .YYYYMMDD  ( day month year --)  4 .R ." /"  2 .R ." /" 2 .R ;
    : .hhmmss    ( sec mins hr --)     2 .R ." :"  2 .R  ;
    
    : .REPEATS ( n --)
        CASE
          0 OF  ." No"     ENDOF
          1 OF  ." Daily"  ENDOF
          2 OF  ." Weekly" ENDOF
               ." ???"
        ENDCASE ;
    
    :  PRINT] ( addr -- )
       CR ." Name: " [REC EVENT] COUNT TYPE  4 SPACES ." Date: " [email protected] .YYYYMMDD
       CR ." Starts:"  [email protected] .hhmmss
       CR ." Duration:" [REC DURATION] @ 4 .R  ."  mins"
       CR ." Repeats: " [REC FLAG] [email protected] .REPEATS
       CR ." Ends: "    [email protected] .YYYYMMDD
    ;
    
    : ERASE]   B/REC 0 FILL ;
    
    : LIST ( -- )  9 0 DO   I REC# [REC PRINT] CR    LOOP ;
    
    
    \ ("E1", 2021, 11, 23, 16, 30, 15, 0, 0, 0, 0)
    \ Since you have defined your event like that I would be temped to make the code
    \ look like that and drop that data into a record. 
    0 REC# '( " E1"  2021,11,23,16,30,15,0,0,0,0 )EVENT
    1 REC# '( " E2"  2021, 11, 23, 16, 30, 15, 1, 2021, 11, 27 )EVENT   
    2 REC# '( " E3"  2021, 11, 23, 16, 30, 15, 2, 2021, 12, 15 )EVENT  
    3 REC# '( " E4"  2021,11,23,16,30,15,0,0,0,0 )EVENT
    4 REC# '( " E5"  2021, 11, 23, 16, 30, 15, 1, 2021, 11, 27 )EVENT   
    5 REC# '( " E6"  2021, 11, 23, 16, 30, 15, 2, 2021, 12, 15 )EVENT  
    6 REC# '( " E7"  2021,11,23,16,30,15,0,0,0,0 )EVENT
    7 REC# '( " E8"  2021, 11, 23, 16, 30, 15, 1, 2021, 11, 27 )EVENT   
    8 REC# '( " E9"  2021, 11, 23, 16, 30, 15, 2, 2021, 12, 15 )EVENT  
    

     

     

     

     

    DATADEMO.png

    • Like 2
×
×
  • Create New...