Jump to content
Lee Stewart

fbForth—TI Forth with File-based Block I/O [Post #1 UPDATED: 11/16/2019]

Recommended Posts

Looks like it's just you and me for awhile, Bob!

 

I think I have all known bugs fixed and all changes working, but I should probably post a beta version for the usual suspects to test. I said, “all bugs fixed”, but I have yet to check that all of my additions of “B @BKLINK” are not buggy. When I am done with that and after a stint on the beach, :P I can post a beta version here, if anyone is interested in testing. :waving:

 

To review, I have

  • Fixed all (most?) bugs caused by my adding “B @BKLINK” calls;
  • Added BYE as a synonym for MON (exit to the Monitor, AKA system reset);
  • Set up PLAY to mute all four sound generators for option 1 before playing the requested sound table (This was a problem when a second sound table was invoked with option 1, if the interrupted (read, “cancelled”) table used a sound channel not used by the interrupting sound table.);
  • If either sound table #1 or #2 is playing, set up option 0 of PLAY to push the new sound table’s address to a sound stack that grows up towards the return stack in low RAM (This will play any and all sound lists invoked with option 0 in the order added (FIFO stack) and does not pause other Forth code, which could happen in a loop with a PLAYING? test.);
  • Changed the ?TERMINAL system routine to call the relevant console routine to check for FCTN+4 and for debouncing if FCTN+4 is detected;
  • Modified FBLOCKS a little. :grin:

Whew! :-o I think that is everything...

 

...lee

Share this post


Link to post
Share on other sites

I'm waiting for the upload. Hopefully, you didn't change the entry point.

 

Nope. Entry point is the same. You just won't be able to run old BSAVEd images. They will need to be BESAVEd from the new build. I will post a beta sometime later today. Right now I'm on the beach!

 

...lee

Share this post


Link to post
Share on other sites

 

Nope. Entry point is the same. You just won't be able to run old BSAVEd images. They will need to be BESAVEd from the new build. I will post a beta sometime later today. Right now I'm on the beach!

 

...lee

Go Forth and be a beach bum ;)

  • Like 1

Share this post


Link to post
Share on other sites

Here is the fbForth 2.0:11 beta for testing:

fbForth2.0_11_beta.zip

 

It only contains the following files (all binaries are in inverted format):

  • fbForth200_9.bin (32 KiB binary image for Classic99 or burning to EPROM)
  • fbForth200.rpk (32 KiB binary image for MAME)
  • fbForth2001.bin (Bank 0--8 KiB binary image)
  • fbForth2002.bin (Bank 1--8 KiB binary image)
  • fbForth2003.bin (Bank 2--8 KiB binary image)
  • fbForth2004.bin (Bank 3--8 KiB binary image)
  • FBLOCKS (System Blocks file)
  • TESTBLKS (Blocks file with sound tables for testing)

You can use TESTBLKS for testing PLAY . The sounds ( CHIME CRASH INFLIGHTSND GROUNDBURSTSND AIRBURSTSND ) can be loaded as follows:

 

USEBFL DSK1.TESTBLKS

2 LOAD

Review PLAY in the Glossary (Appendix D) and Chapter 17 in fbForth 2.0 A File-Based Cartridge Implementation of TI Forth for its usage.

 

Please, let me know if you encounter any problems or if you need assistance setting up testing or understanding something. Barring any trouble, I will post it officially in a few days.

 

...lee

Share this post


Link to post
Share on other sites

I right-justified the info in Block 1 and added "First available Page:". I stuck in an extra CR or two. I used my 2-column MENU and it appears to be complete and working fine.

Share this post


Link to post
Share on other sites

I right-justified the info in Block 1 and added "First available Page:". I stuck in an extra CR or two. I used my 2-column MENU and it appears to be complete and working fine.

 

Cool beans!

 

For those who might be interested, here is the unmodified start-up for fbForth 2.0:11 with FBLOCKS dated 05DEC2017:

 

post-29677-0-10894400-1512576964.gif

 

...lee

Share this post


Link to post
Share on other sites

OK...Now for the game that started me down the path to fbForth 2.0:11 (see post #1421): I now have a working port of J. Volk's conversion from XB to TI Forth of BattleStar. I fixed some bugs and replaced the honk with an explosion sound when the BattleStar blows up. It could use some other sound effects for shooting and hitting ships, but I have not been able to find any suitable sound tables and it is a little daunting to compose my own. It could stand some other improvements as well. I have not looked very diligently for the original XB game for comparison, but anyway, here is the code if you want to have a go at it:

 

 

 

\ NOTES: 
\  1. Check whether random number generation using negative 
\     numbers was intended by J.Volk. I am inclined to write 
\     another function to replace RND in this program with a 
\     function that saves the sign, executes RND and assigns 
\     proper sign.

\ BATTLESTAR- CONVERTED FROM X-BASIC BY J. VOLK 14MAR1984-
\ fbForth 2.0 port by Lee Stewart 15NOV2017    
\ ...moved "GRAPHICS" to RUN
CR
: INSTR CLS 0 0 GOTOXY ." ======== BATTLESTAR ========" CR CR CR
   ."  YOU ARE DEFENDING A BATTLE-" CR 
   ."  STAR DURING A METEOR STORM." CR 
   ."  YOUR LASERS ARE SUPERIOR TO" CR 
   ."  THEIR MISSLES, BUT THEY ATTACK" CR 
   ."  FROM 4 SIDES." CR 
   ."  USE THE ARROW KEYS TO FIRE" CR 
   ."  SCORE 20 FOR EACH MISSLE" CR 
   ."  INTERCEPTED AND 40 FOR " CR 
   ."  EACH SHIP." CR 
   ."  #LOWER LEFT B=BEST A=AVERAGE" CR CR CR CR 
   ."  PRESS ANY KEY TO START" CR CR 
   BEGIN 
      ?KEY 0>
   UNTIL 
   CLS 
;
300 VARIABLE L       \ Lap? 
  0 VARIABLE SC      \ score
  0 VARIABLE SA1 
  0 VARIABLE SB1 
  0 VARIABLE SA2 
  0 VARIABLE SB2 
  0 VARIABLE SA3 
  0 VARIABLE SB3 
  0 VARIABLE SA4 
  0 VARIABLE SB4 
  0 VARIABLE BS      \ best score
  0 VARIABLE AV      \ average score
  0 VARIABLE GM      \ games played
  0 VARIABLE P1 
  0 VARIABLE P2 
  0 VARIABLE P7 
  0 VARIABLE P8
  0 VARIABLE TS      \ total score
  0 VARIABLE NS
  0 VARIABLE DONE    \ set by DESTRUCT

HEX 
: MAKECHRS 
   1 6 9 COLOR 
   1 5 10 COLOR
   800 SSDT
   DATA[
      0000 0000 0007 0707 1818 183C 7EFF DB99
      0000 0000 00E0 E0E0 070E 1CFF FF1C 0E07
      E0E0 E000 0000 0000 E070 38FF FF38 70E0
      0707 0707 0000 0000 99DB FF7E 3C18 1818
      1842 3C99 993C 4218 1818 1818 1818 1818
      0000 00FF FF00 0000 1046 2824 0A92 3044
   ]DATA 60 SPDCHAR
   DATA[
      3078 7C47 7C78 3000 1010 386C EEEE 7C00
      0C1E 3EE2 3E1E 0C00 007C EEEE 6C38 1010
      1010 38FE 3810 1000 0000 183C FF7E 2442
   ]DATA 70 SPDCHAR
 ;   
: EXPLODE  ( -- addr )    DATA[
   079F BFC2 0EDF E3F0 0302 E5F0 1502 E3F2 0302 E5F2 1202 E3F4
   0202 E5F4 1002 E3F6 0202 E5F6 0802 E3F8 0102 E5FA 0604 FFDF
   BF9F 0000 ]DATA DROP ;

DECIMAL
 
: RND+-  ( n1 -- n2 )   \ generates PRN with sign of n1
   DUP ABS RND 
   SWAP 0< IF 
      MINUS 
   THEN
;
: WHITEONBLACK
   16 0 DO 
      15 1 I COLOR 
   LOOP 
;
: SETCHRS 
   \ set color for char sets 0..14 to white on black 
   WHITEONBLACK
   
   \ screen to black and clear it
   1 SCREEN CLS 
   
   \ randomly place 30 asteroids at columns 1..30, rows 1..20
   30 0 DO 
      30 RND 1+ 20 RND 1+ 1 46 VCHAR 
   LOOP 
   
   \ place battlestar
   113 81 15 96 10 SPRITE     \ top left
   121 81 15 97 11 SPRITE     \ top middle
   129 81 15 98 12 SPRITE     \ top right
   113 89 15 99 13 SPRITE     \ middle left
   121 89 7 104 14 SPRITE     \ middle middle
   129 89 15 101 15 SPRITE    \ middle right
   113 97 15 102 16 SPRITE    \ bottom left
   121 97 15 103 17 SPRITE    \ bottom middle
   129 97 15 100 18 SPRITE    \ bottom right
   
   \ set up 4 meteorites with random velocities
   50 99 15 46 19 SPRITE 
   127 RND -50 RND+- 19 MOTION   \ -50 RND not negative!
   10 1 15 46 20 SPRITE 
   -120 RND+- 50 RND 20 MOTION 
   1 20 15 46 21 SPRITE 
   25 RND -99 RND+- 21 MOTION 
   1 5 15 46 22 SPRITE 
   10 RND -50 RND+- 22 MOTION 
   
   \ set all sprites in motion
   31 #MOTION 
; 
: DISPLAYIT 
   3 20 GOTOXY ." B= " 
   3 21 GOTOXY ." A= " 
   1 GM +! 
   TS @ SC @ + TS ! 
   TS @ GM @ / AV ! 
   BS @ SC @ < IF
      SC @ BS ! 
   ENDIF 
   7 20 GOTOXY BS @ . 
   7 21 GOTOXY AV @ . 
; 
: DELAY 
   250 0 DO 
      I DROP 
   LOOP 
; 
: CLEARSPRITE     \ clear alien sprites
   0 0 1 MOTION 1 DELSPR 
   0 0 2 MOTION 2 DELSPR 
   0 0 3 MOTION 3 DELSPR 
   0 0 4 MOTION 4 DELSPR 
;
: DESTRUCT 
   1 DONE !
   CLEARSPRITE 
   EXPLODE 1 PLAY
   29 10 DO 
      40 RND 20 - 40 RND 20 - I MOTION
      107 I SPRPAT 
   LOOP 
   50 0 DO 
      DELAY 
   LOOP
   SC @ TS @ + TS ! 
   TS @ GM @ / AV !           \ '/' was missing
   BS @ SC @ < IF 
      SC @ BS ! 
   ENDIF 
   S" GAMEOVER" COUNT SWAP OVER  \ S:cnt addr cnt
   TIB @ SWAP                    \ S:cnt addr [TIB] cnt
   CMOVE                         \ S:cnt
   TIB @ + 2                     \ S:cnt+[TIB] 2
   ERASE                         \ 2 zeros
   0 BLK ! 0 IN !                \ interpret TIB
;
: UP 
   SA1 @ 0= 
   SB1 @ 0= AND               \ "1 =" extraneous
   IF 
      15 0 10 105 VCHAR 
      DELAY 
      15 0  10 32 VCHAR 
      -10 SC +!
      ;S 
   ENDIF 
   SB1 @ 0= IF 
      15 0 9 105 VCHAR 
      DELAY 
      15 0 9 32 VCHAR 
      50 SC +! 
      0 SA1 ! 
      ;S 
   ENDIF 
   1 SPRGET P2 ! P1 !
   1 11 9 COINC               \ "1 =" extraneous
   IF 
      DESTRUCT 
   ELSE
      P2 @ 8 / 1+ P2 ! 
      15 P2 @ 5 105 VCHAR 
      DELAY 
      15 P2 @ 5 32  VCHAR
      0 0 1 MOTION 
      1 DELSPR 
      20 SC +! 
      0 SB1 ! 
   THEN
;
: LEFT 
   SA2 @ 0= 
   SB2 @ 0= AND               \ "1 =" extraneous
   IF 
      0 11 14 106 HCHAR 
      DELAY 
      0 11 14 32 HCHAR
      -10 SC +! 
      ;S 
   ENDIF 
   SB2 @ 0= IF
      2 11 12 106 HCHAR
      DELAY 
      2 11 12 32 HCHAR 
      50 SC +! 
      0 SA2 ! 
      ;S 
   ENDIF 
   2 SPRGET P2 ! P1 ! 
   P2 @ 106 > IF
      DESTRUCT 
   ELSE 
      P2 @ 8 / 1+ P2 !           \ error in source
      P2 @ 11 15 P2 @ - 106 HCHAR 
      DELAY 
      P2 @ 11 15 P2 @ - 32 HCHAR
      0 0 2 MOTION 
      2 DELSPR 
      20 SC +! 
      0 SB2 ! 
   THEN
;
: DOWN 
   SA3 @ 0= SB3 @ 0= AND      \ "1 =" extraneous
   IF
      15 13 10 105 VCHAR 
      DELAY 
      15 13 10 32 VCHAR 
      -10 SC +! 
      ;S 
   ENDIF 
   SB3 @ 0= IF 
      15 13 10 105 VCHAR 
      DELAY 
      15 13 10 32 VCHAR 
      50 SC +! 
      0 SA3 ! 
      ;S 
   ENDIF 
   3 SPRGET P2 ! P1 ! 
   3 17 5 COINC               \ "1 =" extraneous
   IF 
      DESTRUCT 
   ELSE            
      P1 @ 8 / 1+ P1 ! 
      15 13 P1 @ 14 - 105 VCHAR 
      DELAY 
      15 13 P1 @ 14 - 32 VCHAR
      0 0 3 MOTION 
      3 DELSPR 
      20 SC +! 
      0 SB3 ! 
   THEN
;  
: RIGHT 
   SA4 @ 0= SB4 @ 0= AND      \ "1 =" extraneous
   IF 
      17 11 14 106 HCHAR 
      DELAY
      17 11 14 32 HCHAR 
      -10 SC +! 
      ;S 
   ENDIF 
   SB4 @ 0= IF 
      17 11 14 106 HCHAR 
      DELAY 
      17 11 14 32 HCHAR 
      50 SC +! 
      0 SA4 ! 
      ;S 
   ENDIF 
   4 SPRGET P2 ! P1 ! 
   4 15 5 COINC               \ "1 =" extraneous
   IF 
      DESTRUCT 
   ELSE
      P2 @ 8 / P2 ! 
      17 11 P2 @ 10 - 106 HCHAR 
      DELAY 
      17 11 P2 @ 10 - 32 HCHAR 
      0 0 4 MOTION
      4 DELSPR 
      20 SC +! 
      0 SB4 ! 
   THEN
;
: KEYIN 
   ?KEY -DUP   \ only DUP if non-zero   \ "DUP 0>" not used properly here!
   IF
      CASE 
         69 OF UP ENDOF 
         83 OF LEFT ENDOF 
         88 OF DOWN ENDOF 
         68 OF RIGHT ENDOF 
      ENDCASE 
   ENDIF 
;
: GET1 
   SA1 @ SB1 @ AND            \ 3 instances of "1 =" extraneous
   IF
      ;S 
   ENDIF 
   15 1 1 115 HCHAR
   1 SA1 ! 
   SB1 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      120 17 6 116 1 SPRITE
      0 11 L @ 10 / - 1 MOTION 
      1 SB1 ! 
   ENDIF 
;
: GET2 
   SA2 @ SB2 @ AND            \ 3 instances of "1 =" extraneous
   IF 
      ;S 
   ENDIF 
   2 11 1 112 HCHAR
   1 SA2 ! 
   SB2 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      17 88 6 116 2 SPRITE 
      11 L @ 10 / - 0 2 MOTION 
      1 SB2 ! 
   ENDIF 
;  
: GET3 
   SA3 @ SB3 @ AND            \ 3 instances of "1 =" extraneous
   IF 
      ;S 
   ENDIF 
   15 22 1 113 HCHAR
   1 SA3 ! 
   SB3 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      120 175 6 116 3 SPRITE
      0 -11 L @ 10 / + 3 MOTION 
      1 SB3 ! 
   ENDIF 
;
: GET4 
   SA4 @ SB4 @ AND            \ 3 instances of "1 =" extraneous
   IF 
      ;S 
   ENDIF 
   29 11 1 114 HCHAR
   1 SA4 ! 
   SB4 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      216 88 6 116 4 SPRITE 
      -11 L @ 10 / + 0 4 MOTION 
      1 SB4 ! 
   ENDIF 
;
: CHECK&CHOOSE 
   SB1 @ 0= IF
      0 P1 ! 0 P2 ! 
   ELSE 
      1 SPRGET P2 ! P1 ! 
   ENDIF 
   SB4 @ 0= IF
      0 P7 ! 0 P8 ! 
   ELSE 
      4 SPRGET P2 ! P1 ! 
   ENDIF
   2 13 5 COINC 
   1 11 5 COINC 
   4 15 5 COINC 
   3 17 9 COINC 
   OR OR OR 
   IF
      DESTRUCT 
   ELSE
      L @ RND 1+ NS !
      NS @ 10 > IF 
         ;S 
      ENDIF 
      4 RND 1+ NS ! 
      NS @ CASE 
         1 OF GET1 ENDOF 
         2 OF GET2 ENDOF 
         3 OF GET3 ENDOF 
         4 OF GET4 ENDOF 
      ENDCASE 
   THEN
;
: DONECHECK
   DONE @            \ did we blow up?
   ?TERMINAL         \ user done?
   OR                \ either?
;
: MAIN 
   MAKECHRS 
   SETCHRS 
   DISPLAYIT 
   BEGIN 
      KEYIN 
      CHECK&CHOOSE 
      -1 L +! 
      L @ 1 < IF 
         20 L !
      ENDIF
      3 23 GOTOXY 
      SC @ . SP!  
      DONECHECK
   UNTIL 
;
: RUN 
   GRAPHICS 
   INSTR 
   MAIN 
;
: RESTART 
   0 SC ! 
   200 L ! 
   0 SA1 ! 
   0 SB1 ! 
   0 SA2 ! 
   0 SB2 ! 
   0 SA3 !
   0 SB3 ! 
   0 SA4 ! 
   0 SB4 ! 
   0 P1 ! 
   0 P2 ! 
   0 P7 ! 
   0 P8 ! 
   0 DONE !
   MAIN 
;
: GAMEOVER 
   DELALL CLS FNT
   WHITEONBLACK
   10 4 GOTOXY ." GAME OVER!"
   CR CR CR CR ." YOUR SCORE IS " SC @ .
   CR CR CR ." Go again(y/n)? "
   KEY 223 AND ASCII Y = IF
      RESTART
   ELSE
      COLD
   THEN
; 
RUN
 

 

 

 

...lee

 

[EDIT: See post #1438 for BattleStar with Parsec sounds.]

  • Like 1

Share this post


Link to post
Share on other sites

One interesting statistic comparing builds 10 and 11 is that available low RAM is exactly the same—this with gaining 28 bytes from changing the system code for ?TERMINAL as mentioned in the post at the top of this page and elsewhere. Obviously, my changes to the fbForth ISR to service a sound table stack required exactly 28 bytes!

 

...lee

Share this post


Link to post
Share on other sites

OK...Now for the game that started me down the path to fbForth 2.0:11 (see post #1421): I now have a working port of J. Volk's conversion from XB to TI Forth of BattleStar. I fixed some bugs and replaced the honk with an explosion sound when the BattleStar blows up. It could use some other sound effects for shooting and hitting ships, but I have not been able to find any suitable sound tables and it is a little daunting to compose my own. It could stand some other improvements as well. I have not looked very diligently for the original XB game for comparison, but anyway, here is the code if you want to have a go at it:

 

 

 

\ NOTES: 
\  1. Check whether random number generation using negative 
\     numbers was intended by J.Volk. I am inclined to write 
\     another function to replace RND in this program with a 
\     function that saves the sign, executes RND and assigns 
\     proper sign.

\ BATTLESTAR- CONVERTED FROM X-BASIC BY J. VOLK 14MAR1984-
\ fbForth 2.0 port by Lee Stewart 15NOV2017    
\ ...moved "GRAPHICS" to RUN
CR
: INSTR CLS 0 0 GOTOXY ." ======== BATTLESTAR ========" CR CR CR
   ."  YOU ARE DEFENDING A BATTLE-" CR 
   ."  STAR DURING A METEOR STORM." CR 
   ."  YOUR LASERS ARE SUPERIOR TO" CR 
   ."  THEIR MISSLES, BUT THEY ATTACK" CR 
   ."  FROM 4 SIDES." CR 
   ."  USE THE ARROW KEYS TO FIRE" CR 
   ."  SCORE 20 FOR EACH MISSLE" CR 
   ."  INTERCEPTED AND 40 FOR " CR 
   ."  EACH SHIP." CR 
   ."  #LOWER LEFT B=BEST A=AVERAGE" CR CR CR CR 
   ."  PRESS ANY KEY TO START" CR CR 
   BEGIN 
      ?KEY 0>
   UNTIL 
   CLS 
;
300 VARIABLE L       \ Lap? 
  0 VARIABLE SC      \ score
  0 VARIABLE SA1 
  0 VARIABLE SB1 
  0 VARIABLE SA2 
  0 VARIABLE SB2 
  0 VARIABLE SA3 
  0 VARIABLE SB3 
  0 VARIABLE SA4 
  0 VARIABLE SB4 
  0 VARIABLE BS      \ best score
  0 VARIABLE AV      \ average score
  0 VARIABLE GM      \ games played
  0 VARIABLE P1 
  0 VARIABLE P2 
  0 VARIABLE P7 
  0 VARIABLE P8
  0 VARIABLE TS      \ total score
  0 VARIABLE NS
  0 VARIABLE DONE    \ set by DESTRUCT

HEX 
: MAKECHRS 
   1 6 9 COLOR 
   1 5 10 COLOR
   800 SSDT
   DATA[
      0000 0000 0007 0707 1818 183C 7EFF DB99
      0000 0000 00E0 E0E0 070E 1CFF FF1C 0E07
      E0E0 E000 0000 0000 E070 38FF FF38 70E0
      0707 0707 0000 0000 99DB FF7E 3C18 1818
      1842 3C99 993C 4218 1818 1818 1818 1818
      0000 00FF FF00 0000 1046 2824 0A92 3044
   ]DATA 60 SPDCHAR
   DATA[
      3078 7C47 7C78 3000 1010 386C EEEE 7C00
      0C1E 3EE2 3E1E 0C00 007C EEEE 6C38 1010
      1010 38FE 3810 1000 0000 183C FF7E 2442
   ]DATA 70 SPDCHAR
 ;   
: EXPLODE  ( -- addr )    DATA[
   079F BFC2 0EDF E3F0 0302 E5F0 1502 E3F2 0302 E5F2 1202 E3F4
   0202 E5F4 1002 E3F6 0202 E5F6 0802 E3F8 0102 E5FA 0604 FFDF
   BF9F 0000 ]DATA DROP ;

DECIMAL
 
: RND+-  ( n1 -- n2 )   \ generates PRN with sign of n1
   DUP ABS RND 
   SWAP 0< IF 
      MINUS 
   THEN
;
: WHITEONBLACK
   16 0 DO 
      15 1 I COLOR 
   LOOP 
;
: SETCHRS 
   \ set color for char sets 0..14 to white on black 
   WHITEONBLACK
   
   \ screen to black and clear it
   1 SCREEN CLS 
   
   \ randomly place 30 asteroids at columns 1..30, rows 1..20
   30 0 DO 
      30 RND 1+ 20 RND 1+ 1 46 VCHAR 
   LOOP 
   
   \ place battlestar
   113 81 15 96 10 SPRITE     \ top left
   121 81 15 97 11 SPRITE     \ top middle
   129 81 15 98 12 SPRITE     \ top right
   113 89 15 99 13 SPRITE     \ middle left
   121 89 7 104 14 SPRITE     \ middle middle
   129 89 15 101 15 SPRITE    \ middle right
   113 97 15 102 16 SPRITE    \ bottom left
   121 97 15 103 17 SPRITE    \ bottom middle
   129 97 15 100 18 SPRITE    \ bottom right
   
   \ set up 4 meteorites with random velocities
   50 99 15 46 19 SPRITE 
   127 RND -50 RND+- 19 MOTION   \ -50 RND not negative!
   10 1 15 46 20 SPRITE 
   -120 RND+- 50 RND 20 MOTION 
   1 20 15 46 21 SPRITE 
   25 RND -99 RND+- 21 MOTION 
   1 5 15 46 22 SPRITE 
   10 RND -50 RND+- 22 MOTION 
   
   \ set all sprites in motion
   31 #MOTION 
; 
: DISPLAYIT 
   3 20 GOTOXY ." B= " 
   3 21 GOTOXY ." A= " 
   1 GM +! 
   TS @ SC @ + TS ! 
   TS @ GM @ / AV ! 
   BS @ SC @ < IF
      SC @ BS ! 
   ENDIF 
   7 20 GOTOXY BS @ . 
   7 21 GOTOXY AV @ . 
; 
: DELAY 
   250 0 DO 
      I DROP 
   LOOP 
; 
: CLEARSPRITE     \ clear alien sprites
   0 0 1 MOTION 1 DELSPR 
   0 0 2 MOTION 2 DELSPR 
   0 0 3 MOTION 3 DELSPR 
   0 0 4 MOTION 4 DELSPR 
;
: DESTRUCT 
   1 DONE !
   CLEARSPRITE 
   EXPLODE 1 PLAY
   29 10 DO 
      40 RND 20 - 40 RND 20 - I MOTION
      107 I SPRPAT 
   LOOP 
   50 0 DO 
      DELAY 
   LOOP
   SC @ TS @ + TS ! 
   TS @ GM @ / AV !           \ '/' was missing
   BS @ SC @ < IF 
      SC @ BS ! 
   ENDIF 
   S" GAMEOVER" COUNT SWAP OVER  \ S:cnt addr cnt
   TIB @ SWAP                    \ S:cnt addr [TIB] cnt
   CMOVE                         \ S:cnt
   TIB @ + 2                     \ S:cnt+[TIB] 2
   ERASE                         \ 2 zeros
   0 BLK ! 0 IN !                \ interpret TIB
;
: UP 
   SA1 @ 0= 
   SB1 @ 0= AND               \ "1 =" extraneous
   IF 
      15 0 10 105 VCHAR 
      DELAY 
      15 0  10 32 VCHAR 
      -10 SC +!
      ;S 
   ENDIF 
   SB1 @ 0= IF 
      15 0 9 105 VCHAR 
      DELAY 
      15 0 9 32 VCHAR 
      50 SC +! 
      0 SA1 ! 
      ;S 
   ENDIF 
   1 SPRGET P2 ! P1 !
   1 11 9 COINC               \ "1 =" extraneous
   IF 
      DESTRUCT 
   ELSE
      P2 @ 8 / 1+ P2 ! 
      15 P2 @ 5 105 VCHAR 
      DELAY 
      15 P2 @ 5 32  VCHAR
      0 0 1 MOTION 
      1 DELSPR 
      20 SC +! 
      0 SB1 ! 
   THEN
;
: LEFT 
   SA2 @ 0= 
   SB2 @ 0= AND               \ "1 =" extraneous
   IF 
      0 11 14 106 HCHAR 
      DELAY 
      0 11 14 32 HCHAR
      -10 SC +! 
      ;S 
   ENDIF 
   SB2 @ 0= IF
      2 11 12 106 HCHAR
      DELAY 
      2 11 12 32 HCHAR 
      50 SC +! 
      0 SA2 ! 
      ;S 
   ENDIF 
   2 SPRGET P2 ! P1 ! 
   P2 @ 106 > IF
      DESTRUCT 
   ELSE 
      P2 @ 8 / 1+ P2 !           \ error in source
      P2 @ 11 15 P2 @ - 106 HCHAR 
      DELAY 
      P2 @ 11 15 P2 @ - 32 HCHAR
      0 0 2 MOTION 
      2 DELSPR 
      20 SC +! 
      0 SB2 ! 
   THEN
;
: DOWN 
   SA3 @ 0= SB3 @ 0= AND      \ "1 =" extraneous
   IF
      15 13 10 105 VCHAR 
      DELAY 
      15 13 10 32 VCHAR 
      -10 SC +! 
      ;S 
   ENDIF 
   SB3 @ 0= IF 
      15 13 10 105 VCHAR 
      DELAY 
      15 13 10 32 VCHAR 
      50 SC +! 
      0 SA3 ! 
      ;S 
   ENDIF 
   3 SPRGET P2 ! P1 ! 
   3 17 5 COINC               \ "1 =" extraneous
   IF 
      DESTRUCT 
   ELSE            
      P1 @ 8 / 1+ P1 ! 
      15 13 P1 @ 14 - 105 VCHAR 
      DELAY 
      15 13 P1 @ 14 - 32 VCHAR
      0 0 3 MOTION 
      3 DELSPR 
      20 SC +! 
      0 SB3 ! 
   THEN
;  
: RIGHT 
   SA4 @ 0= SB4 @ 0= AND      \ "1 =" extraneous
   IF 
      17 11 14 106 HCHAR 
      DELAY
      17 11 14 32 HCHAR 
      -10 SC +! 
      ;S 
   ENDIF 
   SB4 @ 0= IF 
      17 11 14 106 HCHAR 
      DELAY 
      17 11 14 32 HCHAR 
      50 SC +! 
      0 SA4 ! 
      ;S 
   ENDIF 
   4 SPRGET P2 ! P1 ! 
   4 15 5 COINC               \ "1 =" extraneous
   IF 
      DESTRUCT 
   ELSE
      P2 @ 8 / P2 ! 
      17 11 P2 @ 10 - 106 HCHAR 
      DELAY 
      17 11 P2 @ 10 - 32 HCHAR 
      0 0 4 MOTION
      4 DELSPR 
      20 SC +! 
      0 SB4 ! 
   THEN
;
: KEYIN 
   ?KEY -DUP   \ only DUP if non-zero   \ "DUP 0>" not used properly here!
   IF
      CASE 
         69 OF UP ENDOF 
         83 OF LEFT ENDOF 
         88 OF DOWN ENDOF 
         68 OF RIGHT ENDOF 
      ENDCASE 
   ENDIF 
;
: GET1 
   SA1 @ SB1 @ AND            \ 3 instances of "1 =" extraneous
   IF
      ;S 
   ENDIF 
   15 1 1 115 HCHAR
   1 SA1 ! 
   SB1 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      120 17 6 116 1 SPRITE
      0 11 L @ 10 / - 1 MOTION 
      1 SB1 ! 
   ENDIF 
;
: GET2 
   SA2 @ SB2 @ AND            \ 3 instances of "1 =" extraneous
   IF 
      ;S 
   ENDIF 
   2 11 1 112 HCHAR
   1 SA2 ! 
   SB2 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      17 88 6 116 2 SPRITE 
      11 L @ 10 / - 0 2 MOTION 
      1 SB2 ! 
   ENDIF 
;  
: GET3 
   SA3 @ SB3 @ AND            \ 3 instances of "1 =" extraneous
   IF 
      ;S 
   ENDIF 
   15 22 1 113 HCHAR
   1 SA3 ! 
   SB3 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      120 175 6 116 3 SPRITE
      0 -11 L @ 10 / + 3 MOTION 
      1 SB3 ! 
   ENDIF 
;
: GET4 
   SA4 @ SB4 @ AND            \ 3 instances of "1 =" extraneous
   IF 
      ;S 
   ENDIF 
   29 11 1 114 HCHAR
   1 SA4 ! 
   SB4 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      216 88 6 116 4 SPRITE 
      -11 L @ 10 / + 0 4 MOTION 
      1 SB4 ! 
   ENDIF 
;
: CHECK&CHOOSE 
   SB1 @ 0= IF
      0 P1 ! 0 P2 ! 
   ELSE 
      1 SPRGET P2 ! P1 ! 
   ENDIF 
   SB4 @ 0= IF
      0 P7 ! 0 P8 ! 
   ELSE 
      4 SPRGET P2 ! P1 ! 
   ENDIF
   2 13 5 COINC 
   1 11 5 COINC 
   4 15 5 COINC 
   3 17 9 COINC 
   OR OR OR 
   IF
      DESTRUCT 
   ELSE
      L @ RND 1+ NS !
      NS @ 10 > IF 
         ;S 
      ENDIF 
      4 RND 1+ NS ! 
      NS @ CASE 
         1 OF GET1 ENDOF 
         2 OF GET2 ENDOF 
         3 OF GET3 ENDOF 
         4 OF GET4 ENDOF 
      ENDCASE 
   THEN
;
: DONECHECK
   DONE @            \ did we blow up?
   ?TERMINAL         \ user done?
   OR                \ either?
;
: MAIN 
   MAKECHRS 
   SETCHRS 
   DISPLAYIT 
   BEGIN 
      KEYIN 
      CHECK&CHOOSE 
      -1 L +! 
      L @ 1 < IF 
         20 L !
      ENDIF
      3 23 GOTOXY 
      SC @ . SP!  
      DONECHECK
   UNTIL 
;
: RUN 
   GRAPHICS 
   INSTR 
   MAIN 
;
: RESTART 
   0 SC ! 
   200 L ! 
   0 SA1 ! 
   0 SB1 ! 
   0 SA2 ! 
   0 SB2 ! 
   0 SA3 !
   0 SB3 ! 
   0 SA4 ! 
   0 SB4 ! 
   0 P1 ! 
   0 P2 ! 
   0 P7 ! 
   0 P8 ! 
   0 DONE !
   MAIN 
;
: GAMEOVER 
   DELALL CLS FNT
   WHITEONBLACK
   10 4 GOTOXY ." GAME OVER!"
   CR CR CR CR ." YOUR SCORE IS " SC @ .
   CR CR CR ." Go again(y/n)? "
   KEY 223 AND ASCII Y = IF
      RESTART
   ELSE
      COLD
   THEN
; 
RUN
 

 

 

 

...lee

This is fun. I have been playing with sound lists and the 9919. Maybe I can come up with a sound or 2 for you.

Share this post


Link to post
Share on other sites

This is fun. I have been playing with sound lists and the 9919. Maybe I can come up with a sound or 2 for you.

 

Actually, you did! I was reviisiting your sound list player thread and picked up the Parsec sounds from you. Here it is with those incorporated:

 

 

 

\ NOTES: 
\  1. Check whether random number generation using negative 
\     numbers was intended by J.Volk. I am inclined to write 
\     another function to replace RND in this program with a 
\     function that saves the sign, executes RND and assigns 
\     proper sign.

\ BATTLESTAR- CONVERTED FROM X-BASIC BY J. VOLK 14MAR1984-
\ fbForth 2.0 port by Lee Stewart 15NOV2017    
\ ...moved "GRAPHICS" to RUN
CR
: INSTR CLS 0 0 GOTOXY ." ======== BATTLESTAR ========" CR CR CR
   ."  YOU ARE DEFENDING A BATTLE-" CR 
   ."  STAR DURING A METEOR STORM." CR 
   ."  YOUR LASERS ARE SUPERIOR TO" CR 
   ."  THEIR MISSLES, BUT THEY ATTACK" CR 
   ."  FROM 4 SIDES." CR 
   ."  USE THE ARROW KEYS TO FIRE" CR 
   ."  SCORE 20 FOR EACH MISSLE" CR 
   ."  INTERCEPTED AND 40 FOR " CR 
   ."  EACH SHIP." CR 
   ."  #LOWER LEFT B=BEST A=AVERAGE" CR CR CR CR 
   ."  PRESS ANY KEY TO START" CR CR 
   BEGIN 
      ?KEY 0>
   UNTIL 
   CLS 
;
300 VARIABLE L       \ Lap? 
  0 VARIABLE SC      \ score
  0 VARIABLE SA1 
  0 VARIABLE SB1 
  0 VARIABLE SA2 
  0 VARIABLE SB2 
  0 VARIABLE SA3 
  0 VARIABLE SB3 
  0 VARIABLE SA4 
  0 VARIABLE SB4 
  0 VARIABLE BS      \ best score
  0 VARIABLE AV      \ average score
  0 VARIABLE GM      \ games played
  0 VARIABLE P1 
  0 VARIABLE P2 
  0 VARIABLE P7 
  0 VARIABLE P8
  0 VARIABLE TS      \ total score
  0 VARIABLE NS
  0 VARIABLE DONE    \ set by DESTRUCT

HEX 
: MAKECHRS 
   1 6 9 COLOR 
   1 5 10 COLOR
   800 SSDT
   DATA[
      0000 0000 0007 0707 1818 183C 7EFF DB99
      0000 0000 00E0 E0E0 070E 1CFF FF1C 0E07
      E0E0 E000 0000 0000 E070 38FF FF38 70E0
      0707 0707 0000 0000 99DB FF7E 3C18 1818
      1842 3C99 993C 4218 1818 1818 1818 1818
      0000 00FF FF00 0000 1046 2824 0A92 3044
   ]DATA 60 SPDCHAR
   DATA[
      3078 7C47 7C78 3000 1010 386C EEEE 7C00
      0C1E 3EE2 3E1E 0C00 007C EEEE 6C38 1010
      1010 38FE 3810 1000 0000 183C FF7E 2442
   ]DATA 70 SPDCHAR
 ;   
: EXPLODE   ( from Parsec )
   DATA[
        079F BFDF E7F0 C007 0501 F106 01F2 0701 F308 01F4
        0901 F510 01F6 1101 F712 01F8 1301 F914 01FA 1501
        FB16 01FC 1701 FD18 01FE 3001 FF00
   ]DATA  DROP  ;
: FIRESND   ( from Parsec )
   DATA[
      049A BFDF FF01 0380 0A98 0103 800C 9601 0380 1094 0103
      8014 9201 0380 1890 0103 801C 9201 0380 2094 0103 8028
      9601 0380 3098 0103 8038 9A01 0380 3E9C 0101 9F00 
   ]DATA  DROP  ;

: FIRE 
   FIRESND 1 PLAY
;
DECIMAL
 
: RND+-  ( n1 -- n2 )   \ generates PRN with sign of n1
   DUP ABS RND 
   SWAP 0< IF 
      MINUS 
   THEN
;
: WHITEONBLACK
   16 0 DO 
      15 1 I COLOR 
   LOOP 
;
: SETCHRS 
   \ set color for char sets 0..14 to white on black 
   WHITEONBLACK
   
   \ screen to black and clear it
   1 SCREEN CLS 
   
   \ randomly place 30 asteroids at columns 1..30, rows 1..20
   30 0 DO 
      30 RND 1+ 20 RND 1+ 1 46 VCHAR 
   LOOP 
   
   \ place battlestar
   113 81 15 96 10 SPRITE     \ top left
   121 81 15 97 11 SPRITE     \ top middle
   129 81 15 98 12 SPRITE     \ top right
   113 89 15 99 13 SPRITE     \ middle left
   121 89 7 104 14 SPRITE     \ middle middle
   129 89 15 101 15 SPRITE    \ middle right
   113 97 15 102 16 SPRITE    \ bottom left
   121 97 15 103 17 SPRITE    \ bottom middle
   129 97 15 100 18 SPRITE    \ bottom right
   
   \ set up 4 meteorites with random velocities
   50 99 15 46 19 SPRITE 
   127 RND -50 RND+- 19 MOTION   \ -50 RND not negative!
   10 1 15 46 20 SPRITE 
   -120 RND+- 50 RND 20 MOTION 
   1 20 15 46 21 SPRITE 
   25 RND -99 RND+- 21 MOTION 
   1 5 15 46 22 SPRITE 
   10 RND -50 RND+- 22 MOTION 
   
   \ set all sprites in motion
   31 #MOTION 
; 
: DISPLAYIT 
   3 20 GOTOXY ." B= " 
   3 21 GOTOXY ." A= " 
   1 GM +! 
   TS @ SC @ + TS ! 
   TS @ GM @ / AV ! 
   BS @ SC @ < IF
      SC @ BS ! 
   ENDIF 
   7 20 GOTOXY BS @ . 
   7 21 GOTOXY AV @ . 
; 
: DELAY 
   250 0 DO 
      I DROP 
   LOOP 
; 
: CLEARSPRITE     \ clear alien sprites
   0 0 1 MOTION 1 DELSPR 
   0 0 2 MOTION 2 DELSPR 
   0 0 3 MOTION 3 DELSPR 
   0 0 4 MOTION 4 DELSPR 
;
: DESTRUCT 
   1 DONE !
   CLEARSPRITE 
   EXPLODE 1 PLAY
   29 10 DO 
      40 RND 20 - 40 RND 20 - I MOTION
      107 I SPRPAT 
   LOOP 
   50 0 DO 
      DELAY 
   LOOP
   SC @ TS @ + TS ! 
   TS @ GM @ / AV !           \ '/' was missing
   BS @ SC @ < IF 
      SC @ BS ! 
   ENDIF 
   S" GAMEOVER" COUNT SWAP OVER  \ S:cnt addr cnt
   TIB @ SWAP                    \ S:cnt addr [TIB] cnt
   CMOVE                         \ S:cnt
   TIB @ + 2                     \ S:cnt+[TIB] 2
   ERASE                         \ 2 zeros
   0 BLK ! 0 IN !                \ interpret TIB
;
: UP 
   FIRE
   SA1 @ 0= 
   SB1 @ 0= AND               \ "1 =" extraneous
   IF 
      15 0 10 105 VCHAR 
      DELAY 
      15 0  10 32 VCHAR 
      -10 SC +!
      ;S 
   ENDIF 
   SB1 @ 0= IF 
      15 0 9 105 VCHAR 
      DELAY 
      15 0 9 32 VCHAR 
      50 SC +! 
      0 SA1 ! 
      ;S 
   ENDIF 
   1 SPRGET P2 ! P1 !
   1 11 9 COINC               \ "1 =" extraneous
   IF 
      DESTRUCT 
   ELSE
      P2 @ 8 / 1+ P2 ! 
      15 P2 @ 5 105 VCHAR 
      DELAY 
      15 P2 @ 5 32  VCHAR
      0 0 1 MOTION 
      1 DELSPR 
      20 SC +! 
      0 SB1 ! 
   THEN
;
: LEFT 
   FIRE
   SA2 @ 0= 
   SB2 @ 0= AND               \ "1 =" extraneous
   IF 
      0 11 14 106 HCHAR 
      DELAY 
      0 11 14 32 HCHAR
      -10 SC +! 
      ;S 
   ENDIF 
   SB2 @ 0= IF
      2 11 12 106 HCHAR
      DELAY 
      2 11 12 32 HCHAR 
      50 SC +! 
      0 SA2 ! 
      ;S 
   ENDIF 
   2 SPRGET P2 ! P1 ! 
   P2 @ 106 > IF
      DESTRUCT 
   ELSE 
      P2 @ 8 / 1+ P2 !           \ error in source
      P2 @ 11 15 P2 @ - 106 HCHAR 
      DELAY 
      P2 @ 11 15 P2 @ - 32 HCHAR
      0 0 2 MOTION 
      2 DELSPR 
      20 SC +! 
      0 SB2 ! 
   THEN
;
: DOWN 
   FIRE
   SA3 @ 0= SB3 @ 0= AND      \ "1 =" extraneous
   IF
      15 13 10 105 VCHAR 
      DELAY 
      15 13 10 32 VCHAR 
      -10 SC +! 
      ;S 
   ENDIF 
   SB3 @ 0= IF 
      15 13 10 105 VCHAR 
      DELAY 
      15 13 10 32 VCHAR 
      50 SC +! 
      0 SA3 ! 
      ;S 
   ENDIF 
   3 SPRGET P2 ! P1 ! 
   3 17 5 COINC               \ "1 =" extraneous
   IF 
      DESTRUCT 
   ELSE            
      P1 @ 8 / 1+ P1 ! 
      15 13 P1 @ 14 - 105 VCHAR 
      DELAY 
      15 13 P1 @ 14 - 32 VCHAR
      0 0 3 MOTION 
      3 DELSPR 
      20 SC +! 
      0 SB3 ! 
   THEN
;  
: RIGHT 
   FIRE
   SA4 @ 0= SB4 @ 0= AND      \ "1 =" extraneous
   IF 
      17 11 14 106 HCHAR 
      DELAY
      17 11 14 32 HCHAR 
      -10 SC +! 
      ;S 
   ENDIF 
   SB4 @ 0= IF 
      17 11 14 106 HCHAR 
      DELAY 
      17 11 14 32 HCHAR 
      50 SC +! 
      0 SA4 ! 
      ;S 
   ENDIF 
   4 SPRGET P2 ! P1 ! 
   4 15 5 COINC               \ "1 =" extraneous
   IF 
      DESTRUCT 
   ELSE
      P2 @ 8 / P2 ! 
      17 11 P2 @ 10 - 106 HCHAR 
      DELAY 
      17 11 P2 @ 10 - 32 HCHAR 
      0 0 4 MOTION
      4 DELSPR 
      20 SC +! 
      0 SB4 ! 
   THEN
;
: KEYIN 
   ?KEY -DUP   \ only DUP if non-zero   \ "DUP 0>" not used properly here!
   IF
      CASE 
         69 OF UP ENDOF 
         83 OF LEFT ENDOF 
         88 OF DOWN ENDOF 
         68 OF RIGHT ENDOF 
      ENDCASE 
   ENDIF 
;
: GET1 
   SA1 @ SB1 @ AND            \ 3 instances of "1 =" extraneous
   IF
      ;S 
   ENDIF 
   15 1 1 115 HCHAR
   1 SA1 ! 
   SB1 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      120 17 6 116 1 SPRITE
      0 11 L @ 10 / - 1 MOTION 
      1 SB1 ! 
   ENDIF 
;
: GET2 
   SA2 @ SB2 @ AND            \ 3 instances of "1 =" extraneous
   IF 
      ;S 
   ENDIF 
   2 11 1 112 HCHAR
   1 SA2 ! 
   SB2 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      17 88 6 116 2 SPRITE 
      11 L @ 10 / - 0 2 MOTION 
      1 SB2 ! 
   ENDIF 
;  
: GET3 
   SA3 @ SB3 @ AND            \ 3 instances of "1 =" extraneous
   IF 
      ;S 
   ENDIF 
   15 22 1 113 HCHAR
   1 SA3 ! 
   SB3 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      120 175 6 116 3 SPRITE
      0 -11 L @ 10 / + 3 MOTION 
      1 SB3 ! 
   ENDIF 
;
: GET4 
   SA4 @ SB4 @ AND            \ 3 instances of "1 =" extraneous
   IF 
      ;S 
   ENDIF 
   29 11 1 114 HCHAR
   1 SA4 ! 
   SB4 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      216 88 6 116 4 SPRITE 
      -11 L @ 10 / + 0 4 MOTION 
      1 SB4 ! 
   ENDIF 
;
: CHECK&CHOOSE 
   SB1 @ 0= IF
      0 P1 ! 0 P2 ! 
   ELSE 
      1 SPRGET P2 ! P1 ! 
   ENDIF 
   SB4 @ 0= IF
      0 P7 ! 0 P8 ! 
   ELSE 
      4 SPRGET P2 ! P1 ! 
   ENDIF
   2 13 5 COINC 
   1 11 5 COINC 
   4 15 5 COINC 
   3 17 9 COINC 
   OR OR OR 
   IF
      DESTRUCT 
   ELSE
      L @ RND 1+ NS !
      NS @ 10 > IF 
         ;S 
      ENDIF 
      4 RND 1+ NS ! 
      NS @ CASE 
         1 OF GET1 ENDOF 
         2 OF GET2 ENDOF 
         3 OF GET3 ENDOF 
         4 OF GET4 ENDOF 
      ENDCASE 
   THEN
;
: DONECHECK
   DONE @            \ did we blow up?
   ?TERMINAL         \ user done?
   OR                \ either?
;
: MAIN 
   MAKECHRS 
   SETCHRS 
   DISPLAYIT 
   BEGIN 
      KEYIN 
      CHECK&CHOOSE 
      -1 L +! 
      L @ 1 < IF 
         20 L !
      ENDIF
      3 23 GOTOXY 
      SC @ . SP!  
      DONECHECK
   UNTIL 
;
: RUN 
   GRAPHICS 
   INSTR 
   MAIN 
;
: RESTART 
   0 SC ! 
   200 L ! 
   0 SA1 ! 
   0 SB1 ! 
   0 SA2 ! 
   0 SB2 ! 
   0 SA3 !
   0 SB3 ! 
   0 SA4 ! 
   0 SB4 ! 
   0 P1 ! 
   0 P2 ! 
   0 P7 ! 
   0 P8 ! 
   0 DONE !
   MAIN 
;
: GAMEOVER 
   DELALL CLS FNT
   WHITEONBLACK
   10 4 GOTOXY ." GAME OVER!"
   CR CR CR CR ." YOUR SCORE IS " SC @ .
   CR CR CR ." Go again(y/n)? "
   KEY 223 AND ASCII Y = IF
      RESTART
   ELSE
      BEGIN ?KEY 0= UNTIL   \ debounce
      COLD
   THEN
; 
RUN
 

 

 

 

I also changed EXPLODE to the Parsec EXPLODE .

 

...lee

Share this post


Link to post
Share on other sites

Hi Lee,

 

Here is a shooter sound and an explosion.

They are in my (new) format but not to hard for you to change them to FB Forth

The explosion is a variation on the Parsec explosion but is slips through three

"bandwidths" of white noise starting with the highest frequency one and going down.

Parsec stays on the same one and just ramps the decay down.

 

I used my SOUND words to make sound and also print out the hex code at the same time as you can see in the jpeg.

Makes an pretty nice tool for exploring.

HEX
CREATE LASER \ 420 hz
       BYTE 4 9F BF DF FF 0
       BYTE 8 8A 10 C2 1 DF 92 E3 F0 5
       BYTE 4 8F 10 92 F1 10
       BYTE 2 94 F2 20
       BYTE 2 96 F3 20
       BYTE 4 8E 11 97 F4 15
       BYTE 2 9A F9 35
       BYTE 2 9F FF 1

/END


CREATE EXPLODE
       BYTE 7 9F BF DF E5 F0 C0 07 5
       BYTE 1 F1 6
       BYTE 1 F2 7
       BYTE 1 F3 8
       BYTE 1 F4 9
       BYTE 2 E6 F5 10
       BYTE 1 F6 11
       BYTE 1 F7 12
       BYTE 1 F8 13
       BYTE 2 E7 F9 14
       BYTE 1 FA 15
       BYTE 1 FB 16
       BYTE 1 FC 17
       BYTE 1 FD 18
       BYTE 1 FE 30
       BYTE 1 FF 0
/END

post-50750-0-64802700-1512619846.jpg

  • Like 1

Share this post


Link to post
Share on other sites

 

Actually, you did! I was reviisiting your sound list player thread and picked up the Parsec sounds from you. Here it is with those incorporated:

 

 

 

\ NOTES: 
\  1. Check whether random number generation using negative 
\     numbers was intended by J.Volk. I am inclined to write 
\     another function to replace RND in this program with a 
\     function that saves the sign, executes RND and assigns 
\     proper sign.

\ BATTLESTAR- CONVERTED FROM X-BASIC BY J. VOLK 14MAR1984-
\ fbForth 2.0 port by Lee Stewart 15NOV2017    
\ ...moved "GRAPHICS" to RUN
CR
: INSTR CLS 0 0 GOTOXY ." ======== BATTLESTAR ========" CR CR CR
   ."  YOU ARE DEFENDING A BATTLE-" CR 
   ."  STAR DURING A METEOR STORM." CR 
   ."  YOUR LASERS ARE SUPERIOR TO" CR 
   ."  THEIR MISSLES, BUT THEY ATTACK" CR 
   ."  FROM 4 SIDES." CR 
   ."  USE THE ARROW KEYS TO FIRE" CR 
   ."  SCORE 20 FOR EACH MISSLE" CR 
   ."  INTERCEPTED AND 40 FOR " CR 
   ."  EACH SHIP." CR 
   ."  #LOWER LEFT B=BEST A=AVERAGE" CR CR CR CR 
   ."  PRESS ANY KEY TO START" CR CR 
   BEGIN 
      ?KEY 0>
   UNTIL 
   CLS 
;
300 VARIABLE L       \ Lap? 
  0 VARIABLE SC      \ score
  0 VARIABLE SA1 
  0 VARIABLE SB1 
  0 VARIABLE SA2 
  0 VARIABLE SB2 
  0 VARIABLE SA3 
  0 VARIABLE SB3 
  0 VARIABLE SA4 
  0 VARIABLE SB4 
  0 VARIABLE BS      \ best score
  0 VARIABLE AV      \ average score
  0 VARIABLE GM      \ games played
  0 VARIABLE P1 
  0 VARIABLE P2 
  0 VARIABLE P7 
  0 VARIABLE P8
  0 VARIABLE TS      \ total score
  0 VARIABLE NS
  0 VARIABLE DONE    \ set by DESTRUCT

HEX 
: MAKECHRS 
   1 6 9 COLOR 
   1 5 10 COLOR
   800 SSDT
   DATA[
      0000 0000 0007 0707 1818 183C 7EFF DB99
      0000 0000 00E0 E0E0 070E 1CFF FF1C 0E07
      E0E0 E000 0000 0000 E070 38FF FF38 70E0
      0707 0707 0000 0000 99DB FF7E 3C18 1818
      1842 3C99 993C 4218 1818 1818 1818 1818
      0000 00FF FF00 0000 1046 2824 0A92 3044
   ]DATA 60 SPDCHAR
   DATA[
      3078 7C47 7C78 3000 1010 386C EEEE 7C00
      0C1E 3EE2 3E1E 0C00 007C EEEE 6C38 1010
      1010 38FE 3810 1000 0000 183C FF7E 2442
   ]DATA 70 SPDCHAR
 ;   
: EXPLODE   ( from Parsec )
   DATA[
        079F BFDF E7F0 C007 0501 F106 01F2 0701 F308 01F4
        0901 F510 01F6 1101 F712 01F8 1301 F914 01FA 1501
        FB16 01FC 1701 FD18 01FE 3001 FF00
   ]DATA  DROP  ;
: FIRESND   ( from Parsec )
   DATA[
      049A BFDF FF01 0380 0A98 0103 800C 9601 0380 1094 0103
      8014 9201 0380 1890 0103 801C 9201 0380 2094 0103 8028
      9601 0380 3098 0103 8038 9A01 0380 3E9C 0101 9F00 
   ]DATA  DROP  ;

: FIRE 
   FIRESND 1 PLAY
;
DECIMAL
 
: RND+-  ( n1 -- n2 )   \ generates PRN with sign of n1
   DUP ABS RND 
   SWAP 0< IF 
      MINUS 
   THEN
;
: WHITEONBLACK
   16 0 DO 
      15 1 I COLOR 
   LOOP 
;
: SETCHRS 
   \ set color for char sets 0..14 to white on black 
   WHITEONBLACK
   
   \ screen to black and clear it
   1 SCREEN CLS 
   
   \ randomly place 30 asteroids at columns 1..30, rows 1..20
   30 0 DO 
      30 RND 1+ 20 RND 1+ 1 46 VCHAR 
   LOOP 
   
   \ place battlestar
   113 81 15 96 10 SPRITE     \ top left
   121 81 15 97 11 SPRITE     \ top middle
   129 81 15 98 12 SPRITE     \ top right
   113 89 15 99 13 SPRITE     \ middle left
   121 89 7 104 14 SPRITE     \ middle middle
   129 89 15 101 15 SPRITE    \ middle right
   113 97 15 102 16 SPRITE    \ bottom left
   121 97 15 103 17 SPRITE    \ bottom middle
   129 97 15 100 18 SPRITE    \ bottom right
   
   \ set up 4 meteorites with random velocities
   50 99 15 46 19 SPRITE 
   127 RND -50 RND+- 19 MOTION   \ -50 RND not negative!
   10 1 15 46 20 SPRITE 
   -120 RND+- 50 RND 20 MOTION 
   1 20 15 46 21 SPRITE 
   25 RND -99 RND+- 21 MOTION 
   1 5 15 46 22 SPRITE 
   10 RND -50 RND+- 22 MOTION 
   
   \ set all sprites in motion
   31 #MOTION 
; 
: DISPLAYIT 
   3 20 GOTOXY ." B= " 
   3 21 GOTOXY ." A= " 
   1 GM +! 
   TS @ SC @ + TS ! 
   TS @ GM @ / AV ! 
   BS @ SC @ < IF
      SC @ BS ! 
   ENDIF 
   7 20 GOTOXY BS @ . 
   7 21 GOTOXY AV @ . 
; 
: DELAY 
   250 0 DO 
      I DROP 
   LOOP 
; 
: CLEARSPRITE     \ clear alien sprites
   0 0 1 MOTION 1 DELSPR 
   0 0 2 MOTION 2 DELSPR 
   0 0 3 MOTION 3 DELSPR 
   0 0 4 MOTION 4 DELSPR 
;
: DESTRUCT 
   1 DONE !
   CLEARSPRITE 
   EXPLODE 1 PLAY
   29 10 DO 
      40 RND 20 - 40 RND 20 - I MOTION
      107 I SPRPAT 
   LOOP 
   50 0 DO 
      DELAY 
   LOOP
   SC @ TS @ + TS ! 
   TS @ GM @ / AV !           \ '/' was missing
   BS @ SC @ < IF 
      SC @ BS ! 
   ENDIF 
   S" GAMEOVER" COUNT SWAP OVER  \ S:cnt addr cnt
   TIB @ SWAP                    \ S:cnt addr [TIB] cnt
   CMOVE                         \ S:cnt
   TIB @ + 2                     \ S:cnt+[TIB] 2
   ERASE                         \ 2 zeros
   0 BLK ! 0 IN !                \ interpret TIB
;
: UP 
   FIRE
   SA1 @ 0= 
   SB1 @ 0= AND               \ "1 =" extraneous
   IF 
      15 0 10 105 VCHAR 
      DELAY 
      15 0  10 32 VCHAR 
      -10 SC +!
      ;S 
   ENDIF 
   SB1 @ 0= IF 
      15 0 9 105 VCHAR 
      DELAY 
      15 0 9 32 VCHAR 
      50 SC +! 
      0 SA1 ! 
      ;S 
   ENDIF 
   1 SPRGET P2 ! P1 !
   1 11 9 COINC               \ "1 =" extraneous
   IF 
      DESTRUCT 
   ELSE
      P2 @ 8 / 1+ P2 ! 
      15 P2 @ 5 105 VCHAR 
      DELAY 
      15 P2 @ 5 32  VCHAR
      0 0 1 MOTION 
      1 DELSPR 
      20 SC +! 
      0 SB1 ! 
   THEN
;
: LEFT 
   FIRE
   SA2 @ 0= 
   SB2 @ 0= AND               \ "1 =" extraneous
   IF 
      0 11 14 106 HCHAR 
      DELAY 
      0 11 14 32 HCHAR
      -10 SC +! 
      ;S 
   ENDIF 
   SB2 @ 0= IF
      2 11 12 106 HCHAR
      DELAY 
      2 11 12 32 HCHAR 
      50 SC +! 
      0 SA2 ! 
      ;S 
   ENDIF 
   2 SPRGET P2 ! P1 ! 
   P2 @ 106 > IF
      DESTRUCT 
   ELSE 
      P2 @ 8 / 1+ P2 !           \ error in source
      P2 @ 11 15 P2 @ - 106 HCHAR 
      DELAY 
      P2 @ 11 15 P2 @ - 32 HCHAR
      0 0 2 MOTION 
      2 DELSPR 
      20 SC +! 
      0 SB2 ! 
   THEN
;
: DOWN 
   FIRE
   SA3 @ 0= SB3 @ 0= AND      \ "1 =" extraneous
   IF
      15 13 10 105 VCHAR 
      DELAY 
      15 13 10 32 VCHAR 
      -10 SC +! 
      ;S 
   ENDIF 
   SB3 @ 0= IF 
      15 13 10 105 VCHAR 
      DELAY 
      15 13 10 32 VCHAR 
      50 SC +! 
      0 SA3 ! 
      ;S 
   ENDIF 
   3 SPRGET P2 ! P1 ! 
   3 17 5 COINC               \ "1 =" extraneous
   IF 
      DESTRUCT 
   ELSE            
      P1 @ 8 / 1+ P1 ! 
      15 13 P1 @ 14 - 105 VCHAR 
      DELAY 
      15 13 P1 @ 14 - 32 VCHAR
      0 0 3 MOTION 
      3 DELSPR 
      20 SC +! 
      0 SB3 ! 
   THEN
;  
: RIGHT 
   FIRE
   SA4 @ 0= SB4 @ 0= AND      \ "1 =" extraneous
   IF 
      17 11 14 106 HCHAR 
      DELAY
      17 11 14 32 HCHAR 
      -10 SC +! 
      ;S 
   ENDIF 
   SB4 @ 0= IF 
      17 11 14 106 HCHAR 
      DELAY 
      17 11 14 32 HCHAR 
      50 SC +! 
      0 SA4 ! 
      ;S 
   ENDIF 
   4 SPRGET P2 ! P1 ! 
   4 15 5 COINC               \ "1 =" extraneous
   IF 
      DESTRUCT 
   ELSE
      P2 @ 8 / P2 ! 
      17 11 P2 @ 10 - 106 HCHAR 
      DELAY 
      17 11 P2 @ 10 - 32 HCHAR 
      0 0 4 MOTION
      4 DELSPR 
      20 SC +! 
      0 SB4 ! 
   THEN
;
: KEYIN 
   ?KEY -DUP   \ only DUP if non-zero   \ "DUP 0>" not used properly here!
   IF
      CASE 
         69 OF UP ENDOF 
         83 OF LEFT ENDOF 
         88 OF DOWN ENDOF 
         68 OF RIGHT ENDOF 
      ENDCASE 
   ENDIF 
;
: GET1 
   SA1 @ SB1 @ AND            \ 3 instances of "1 =" extraneous
   IF
      ;S 
   ENDIF 
   15 1 1 115 HCHAR
   1 SA1 ! 
   SB1 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      120 17 6 116 1 SPRITE
      0 11 L @ 10 / - 1 MOTION 
      1 SB1 ! 
   ENDIF 
;
: GET2 
   SA2 @ SB2 @ AND            \ 3 instances of "1 =" extraneous
   IF 
      ;S 
   ENDIF 
   2 11 1 112 HCHAR
   1 SA2 ! 
   SB2 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      17 88 6 116 2 SPRITE 
      11 L @ 10 / - 0 2 MOTION 
      1 SB2 ! 
   ENDIF 
;  
: GET3 
   SA3 @ SB3 @ AND            \ 3 instances of "1 =" extraneous
   IF 
      ;S 
   ENDIF 
   15 22 1 113 HCHAR
   1 SA3 ! 
   SB3 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      120 175 6 116 3 SPRITE
      0 -11 L @ 10 / + 3 MOTION 
      1 SB3 ! 
   ENDIF 
;
: GET4 
   SA4 @ SB4 @ AND            \ 3 instances of "1 =" extraneous
   IF 
      ;S 
   ENDIF 
   29 11 1 114 HCHAR
   1 SA4 ! 
   SB4 @ 0= L @ 80 < AND      \ "1 =" extraneous
   IF 
      216 88 6 116 4 SPRITE 
      -11 L @ 10 / + 0 4 MOTION 
      1 SB4 ! 
   ENDIF 
;
: CHECK&CHOOSE 
   SB1 @ 0= IF
      0 P1 ! 0 P2 ! 
   ELSE 
      1 SPRGET P2 ! P1 ! 
   ENDIF 
   SB4 @ 0= IF
      0 P7 ! 0 P8 ! 
   ELSE 
      4 SPRGET P2 ! P1 ! 
   ENDIF
   2 13 5 COINC 
   1 11 5 COINC 
   4 15 5 COINC 
   3 17 9 COINC 
   OR OR OR 
   IF
      DESTRUCT 
   ELSE
      L @ RND 1+ NS !
      NS @ 10 > IF 
         ;S 
      ENDIF 
      4 RND 1+ NS ! 
      NS @ CASE 
         1 OF GET1 ENDOF 
         2 OF GET2 ENDOF 
         3 OF GET3 ENDOF 
         4 OF GET4 ENDOF 
      ENDCASE 
   THEN
;
: DONECHECK
   DONE @            \ did we blow up?
   ?TERMINAL         \ user done?
   OR                \ either?
;
: MAIN 
   MAKECHRS 
   SETCHRS 
   DISPLAYIT 
   BEGIN 
      KEYIN 
      CHECK&CHOOSE 
      -1 L +! 
      L @ 1 < IF 
         20 L !
      ENDIF
      3 23 GOTOXY 
      SC @ . SP!  
      DONECHECK
   UNTIL 
;
: RUN 
   GRAPHICS 
   INSTR 
   MAIN 
;
: RESTART 
   0 SC ! 
   200 L ! 
   0 SA1 ! 
   0 SB1 ! 
   0 SA2 ! 
   0 SB2 ! 
   0 SA3 !
   0 SB3 ! 
   0 SA4 ! 
   0 SB4 ! 
   0 P1 ! 
   0 P2 ! 
   0 P7 ! 
   0 P8 ! 
   0 DONE !
   MAIN 
;
: GAMEOVER 
   DELALL CLS FNT
   WHITEONBLACK
   10 4 GOTOXY ." GAME OVER!"
   CR CR CR CR ." YOUR SCORE IS " SC @ .
   CR CR CR ." Go again(y/n)? "
   KEY 223 AND ASCII Y = IF
      RESTART
   ELSE
      BEGIN ?KEY 0= UNTIL   \ debounce
      COLD
   THEN
; 
RUN
 

 

 

 

I also changed EXPLODE to the Parsec EXPLODE .

 

...lee

That's pretty cool.

 

When you get some time try the other sounds just to say we didn't completely plagiarize. :)

 

So the big question is ... Which source code is easier to understand. BASIC or Forth?

 

B

Share this post


Link to post
Share on other sites

OK...So far no one has found any bugs in the fbForth 2.0:11 beta. Actually, I am not sure anyone but Yours Truly has been doing any testing—I really would like some testing by others—but I know we Forthers are few. You know that it is hardest to find the mistakes you know you did not make—so, let us test!

 

In the interim, I have decided to

  • Add CMOVE> and ABORT"
  • Not save memory by having MOVE jump into CMOVE
  • Not make MOVE and CMOVE overlap safe

This brings the available ROM space to

      Bytes
Bank  Left
----  -----
 0      34
 1     170
 2     156
 3      50 

Here is another beta with the above additions:

 

fbForth2.0_11_beta2.zip

 

Have at it!

 

...lee

Share this post


Link to post
Share on other sites

Give me the chance to finish my TI setup and learn Forth first... :-)

Edited by AMenard
  • Like 1

Share this post


Link to post
Share on other sites
HEX
CREATE LASER \ 420 hz
       BYTE 4 9F BF DF FF 0
       BYTE 8 8A 10 C2 1 DF 92 E3 F0 5
       BYTE 4 8F 10 92 F1 10
       BYTE 2 94 F2 20
       BYTE 2 96 F3 20
       BYTE 4 8E 11 97 F4 15
       BYTE 2 9A F9 35
       BYTE 2 9F FF 1

/END

 

LASER does not play as written because there is a 0 duration byte for the first sound list, which turns off sound not only initially but also for the rest of that sound table for the fbForth 2.0 ISR. I think the console ISR handles sound tables that way as well. Turning off all sound generators at the beginning is not a bad practice, but it needs to have a duration byte of at least 1 for playing to continue through the remainder of the sound table.

 

By the way, the fbForth 2.0 ISR turns off all sound generators before it starts processing a sound table. Maybe that is too presumptive on my part, but I digress.

 

Now, if I change that first duration byte to 1, the ISR plays the sound table, but it does not stop there because there is a duration byte of 1 at the end. The upshot is that the ISR continues playing whatever it finds in memory until there is either a duration byte of 0 or a load-number-of-bytes byte of 0. This process is unlikely to turn off all sound channels.

 

The solution to the runaway sound table is either to change that last duration byte to 0 or add a zero byte after it to indicate no bytes to load, which also stops sound table processing.

 

Presuming that the sound table is correct otherwise, the laser sound seems too slow to me. Perhaps it is, in fact, mistyped. What up? :ponder:

 

...lee

Share this post


Link to post
Share on other sites

Well I am using my own player so it interprets this differently.

I will fix it with your game so we are on the same page.

 

Standby...

Share this post


Link to post
Share on other sites

Well I am using my own player so it interprets this differently.

I will fix it with your game so we are on the same page.

 

Standby...

 

Oops! The problem at the end of the sound table is my problem! You put a zero word at the end of each table with /END , which I had intended to include, but obviously forgot. The 0 duration byte , though, is still a problem for me when it is not the last one in the sound table.

 

...lee

Share this post


Link to post
Share on other sites

So... I had been playing with a playback speed variable and changed it without knowing it so that is why the durations are all wrong.

This is the sound I was playing with. Sounds kind of wimpy to me now. :-)

 

Gotta leave for a while. Star trek is on :-)

: FIRESND   ( from Parsec )
   DATA[
        088A 10C2 01DF 92E3 F007
        048F 1092 F102
        0294 F203
        0296 F303
        048E 1197 F403
        029A F503
        038F 9FFF 0100
   ]DATA  DROP  ;

  • Like 1

Share this post


Link to post
Share on other sites

This is a reminder to those 6 folks who downloaded the fbForth 2.0:11β back in post #1441 and anyone else who wants in on the fun to let me know ASAP of any difficulties you might have found because I want to release fbForth 2.0:11 within the next week or so.

 

...lee

Share this post


Link to post
Share on other sites
I just received a paper copy of the fbForth manual. Much easier to digest! Lee, thanks for all your work on this. The list of differences with Starting Forth is a gem: I wish I'd had that for TI FORTH in 1984 when some kind engineer gave me that book!


I especially enjoyed the chapter on division - T-division and F-division. The example (of the plotter line drawing) answered my question: what application determines if you choose one or the other?


Last weekend I spent some time in fbForth and TI FORTH. All of my hobby time has been on various FORTHs this year.


-Erik
  • Like 1

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...

  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...