+Lee Stewart Posted November 27, 2018 Author Share Posted November 27, 2018 I think I get it now. ?OF should actually find 2 numbers on the stack, viz., the number being tested by CASE and the flag. I have not yet tested what follows, but I think it will work. The idea of the code is to toggle the flag and add it to a duplicate of the test number before presenting it to OF . A false flag will then force a mismatch, while a true flag will force a match. It must be paired with ENDOF . Here it is for Camel99 Forth: : ?OF \ compile-time: ( 4 -- here 5 ) run-time: ( n flag -- []|n) \ toggling flag will force proper match/mismatch for OF POSTPONE 0= POSTPONE OVER POSTPONE + \ S:n flag'+n POSTPONE OF ; IMMEDIATE Here is the equivalent fbForth version: : ?OF \ compile-time: ( 4 -- here 5 ) run-time: ( n flag -- []|n) \ toggling flag will force proper match/mismatch for OF COMPILE 0= COMPILE OVER COMPILE + \ S:n flag'+n [COMPILE] OF ; IMMEDIATE Here is an example of its use (block #41 of FBLOCKS must be loaded to use WITHIN ): : XX ( n -- ) CASE DUP 2 9 WITHIN ?OF ." In range (2,9)." ENDOF ELSEOF ." No match!" ENDOF ENDCASE ; ...lee [Edits in this color.] Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted November 27, 2018 Author Share Posted November 27, 2018 The above version of ?OF works in fbForth 2.0! @TheBF’s example use of ?OF inspired the following word, which requires block #41 of FBLOCKS to be loaded for PICK , WITHIN and -ROT : : RANGEOF \ compile-time ( 4 -- here 5 ) run-time: ( n lo hi -- []|n ) COMPILE 2 COMPILE PICK COMPILE -ROT \ S:n n lo hi COMPILE WITHIN \ S:n flag COMPILE 0= COMPILE OVER COMPILE + \ S:n flag'+n [COMPILE] OF ; IMMEDIATE It must be paired with ENDOF and used within a CASE ... ENDCASE construct as : TEST ( n -- ) CASE 2 9 RANGEOF ." In range." ENDOF ELSEOF ." No match!" ENDOF ENDCASE ; ...lee 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 27, 2018 Share Posted November 27, 2018 Cool! I forgot I posted this experiment. So yeah. That's what I meant. Thanks for figuring it out for me I have been crunching on resurrecting the directed threaded version of CAMEL99 Forth which means fixing the cross-compiler and all the rest. I broke it a year ago, but decided to focus on one code base until I got things working better. My old brain is sweating, but I am getting closer. After DTC I want to take serious run at sub-routine threading with some inline primitives. It should run 3 times faster... in theory. Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted November 27, 2018 Author Share Posted November 27, 2018 As I looked at your code, I realized that Chuck says "the dictionary is your case statement" (or something like that). Here is my interpretation of what that means in regards to your SAVE-FONT word: HEX 400 CONSTANT 1K \ these replace the case statement 800 CONSTANT 2K PABS @ \ VRAM address for PAB HERE \ RAM addres for PAB-BUF (dummy not actually used) PDT \ VRAM address for PAB-VBUF (Pattern Descriptor Table) FILE FONTFIL \ associate above 3 addresses with FONTFIL : CLIP ( n min max -- n') ROT MIN MAX ; ( one of my creations) : SAVE-FONT ( bytes -- ) \ Usage: 1K SAVE-FONT DUP 0 2K CLIP \ could of course use your error code FONTFIL SET-PAB \ set up FONTFIL BL WORD HERE DUP C@ 1+ PAB-ADDR @ 9 + SWAP VMBW \ filename->PAB SV \ save 1 or 2 KiB of binary font image to file ; DECIMAL Another factor that I took from modern Forth practice is the word PLACE ( addr len addr --) PLACE takes a string's address and length and puts it in memory as a counted string. A counted string is what a PAB needs so I created VPLACE to do the job. This might be useful for SAVE-FONT: : VPLACE ( $addr len Vaddr -- ) \ like PLACE, but for VDP RAM 2DUP VSBW 1+ SWAP VMBW ; It might clarify this line and VPLACE is generally useful for any string handling in VDP RAM. \ so this... BL WORD HERE DUP C@ 1+ PAB-ADDR @ 9 + SWAP VMBW \ becomes this BL WORD COUNT PAB-ADDR 9 + VPLACE My 2 cents Canadian. (about 1.44 cents USD so take it for what it's worth) Here is my version, after some re-thinking of SAVE-FONT : HEX \ The following 2 words are Brian Fox’s creations : VPLACE ( addr len vaddr -- ) \ like PLACE, but for RAM to VRAM OVER OVER VSBW 1+ SWAP VMBW ; : CLIP ( n min max -- n') ROT MIN MAX ; PABS @ \ VRAM address for PAB HERE \ RAM addres for PAB-BUF (dummy not actually used) PDT \ VRAM address for PAB-VBUF (Pattern Descriptor Table) FILE FONTFIL \ associate above 3 addresses with FONTFIL \ SAVE-FONT forces bytes to be 1024..2048 : SAVE-FONT \ ( bytes -- ) ( IS:<fontFileName> ) 400 800 CLIP \ forces font file size of 1..2 KiB FONTFIL SET-PAB \ set up FONTFIL BL WORD HERE COUNT \ filename-addr cnt PAB-ADDR @ 9 + \ vaddr VPLACE \ cnt+filename->PAB+9 SV \ save 1024..2048-byte binary font image to file ; \ Usage example: 400 SAVE-FONT DSK1.FONT0230 DECIMAL And, here it is à la MKBFL (requires same preamble as SAVE-FONT): HEX : SVFFL ( IS:<fontFileName> <bytes> ) FONTFIL SET-PAB \ set up FONTFIL BL WORD HERE COUNT \ filename-addr cnt PAB-ADDR @ 9 + \ vaddr VPLACE \ cnt+filename->PAB+9 BL WORD \ <bytes> input string to HERE HERE NUMBER DROP \ convert to 16-bit number on stack 400 800 CLIP \ force font file size of 1..2 KiB SV \ save 1024..2048-byte binary font image to file ; \ Usage example: SVFFL DSK1.FONT0230 400 DECIMAL ...lee 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted December 12, 2018 Author Share Posted December 12, 2018 CF7+/nanoPEB Mounting Utilities— Back in post #1350, about 2 years ago (I cannot believe it has been this long!) I posted utilities for mounting CF7+/nanoPEB volumes in a non-persistent manner and had indicated that a permanent solution might be a little too involved to be worth pursuing. Well, with a little help from code that Guillaume Tello (@moulinaie) had developed for Extended Basic, and with his blessing, I have written a word, CFPMOUNT , that permanently mounts volumes, i.e., they persist after a system reset because the volume#-DSK# associations are stored on the CF card. All of the CF utilities will be in the new FBLOCKS I will post later tonight. Here is that code for those who cannot wait: \ \ CF utilities for checking and changing mounted volumes on a nanoPEB or CF7+ \ HEX : CF? ( -- flag ) \ nanoPEB/CF7 present? 3FF8 VSBR SWPB 3FF9 VSBR + \ get magic number AA03 = ; \ leave TRUE if nanoPEB/CF7+ : CFCHK ( -- ) \ check for presence of CF7+/nanoPEB CF? 0= ABORT" No CF7+/nanoPEB!" ; \ if CF, continue : DSKCHK ( dsk# -- dsk#|[] ) \ check that dsk# 1-3 DUP 1 < \ dsk# < 1? S:dsk# flag1 OVER 3 > \ dsk# > 3? S:dsk# flag1 flag2 OR \ S:flag1+flag2 ABORT" DSK# not 1-3!" ; \ abort if dsk# not 1-3..else S:dsk# : CFVOLS ( -- volDSK1 volDSK2 volDSK3 ) \ get vol#s in DSKs CFCHK \ if CF, continue SP@ 6 - 8312 ! \ reserve 3 cells on stack SP@ 3FFA SWAP 6 VMBR ; \ get vol#s to stack : CFMOUNT ( vol# dsk# -- ) \ mount CF vol# in DSK<dsk#> CFCHK \ if CF, continue DSKCHK \ if dsk# 1-3, continue 1- \ decrement dsk# 1 SLA \ double it 3FFB + \ add to 3FFB S:vol# 3FFB|3FFD|3FFF OVER SWPB OVER 1- \ S:vol# 3FFB|3FFD|3FFF vol#[LSB-MSB] 3FFA|3FFC|3FFE VSBW VSBW ; \ copy bytes of vol# to DSK slot in VRAM \ \ CFMOUNT-PAB is XB pseudo-line: 5,M,O,U,N,T,(,200,1,dsk,179,200,4,v1,v2,v3,v4 \ We will be using it as the PAB for the DSR's subprogram MOUNT, as well. 054D VARIABLE CFMOUNT-PAB DATA[ 4F55 4E54 28C8 0100 B3C8 0400 0000 0000 ]DATA DROP DROP 8342 @ VARIABLE SV8342 \ save word at >8342 before it gets trashed \ DSRLNK 0A to subprogram MOUNT, restoring inner interpreter upon return : DSR-MOUNT ( -- ) 0A 0E SYSTEM \ execute DSR subprogram MOUNT SV8342 @ 8342 ! ; \ restore >8342 in inner interpreter : PUTDSK ( dsk# -- ) \ put dsk# as ASCII into CFMOUNT-PAB 0 <# # #> \ put single digit as packed string at PAD CFMOUNT-PAB 9 + SWAP \ S:src dst cnt CMOVE ; \ copy ASCII dsk# to CFMOUNT-PAB+9 : PUTVOL ( vol# -- ) \ put vol# as ASCII into CFMOUNT-PAB 0 <# # # # # #> \ put 4 digits as packed string at PAD CFMOUNT-PAB 0D + SWAP \ S:src dst cnt CMOVE ; \ copy 4 ASCII digits of vol# to CFMOUNT-PAB+13 \ copy XB pseudo-line to PABS area of VRAM and stash pointer at >832C & >8356 : CFPAB>VRAM ( -- ) PABS @ DUP \ VRAM dst...2 copies CFMOUNT-PAB \ RAM src OVER \ VRAM dst for VMBW 012 \ 18 bytes to copy VMBW \ copy 18 bytes from RAM to VRAM 8356 ! \ namelength pointer for DSRLNK >0A 832C ! ; \ save pointer that MOUNT subprogram expects : CFPMOUNT ( vol# dsk# -- ) \ mount CF vol# permanently in DSK<dsk#> CFCHK \ if CF, continue DSKCHK \ if dsk# 1-3, continue PUTDSK \ put dsk# as ASCII into CFMOUNT-PAB PUTVOL \ put vol# as ASCII into CFMOUNT-PAB CFPAB>VRAM \ copy CFMOUNT-PAB to PABS in VRAM DSR-MOUNT ; \ call MOUNT and restore inner interpreter DECIMAL Later, I will also explain a bit more about what is going on with CFPMOUNT . ...lee 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted December 13, 2018 Author Share Posted December 13, 2018 I updated post #1 with all files related to fbForth 2.0:11, which includes new words, BYE ( -- ) —A synonym for MON SD0 ( -- addr ) —Returns the address of the bottom of the FIFO sound stack in low RAM CMOVE> ( src dst cnt -- ) —Copies cnt bytes of src RAM to dst RAM in the opposite direction as CMOVE , i.e., from high RAM to low RAM. As with CMOVE and MOVE , it is not overlap safe. ABORT" ( flag -- ) (IS:<message>") —If flag is nonzero, <message> is printed and ABORT is executed. See the spoiler in my last post for examples of usage in the definitions of CFCHK and DSKCHK . Also posted is the latest FBLOCKS file, with the new word, CFPMOUNT , added to the Compact Flash Utilities. CFPMOUNT persists the mounting of volumes until the next change, i.e., it survives a system reset or removal of the CF card. You may recall that CFMOUNT actions do not survive a system reset. See post #1480 above for more detail. I will update fbforth.stewkitt.com in the near future. ...lee 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted December 13, 2018 Share Posted December 13, 2018 Hey Lee, Since you and Willsy implement blocks as files, it is making me think about using a "BLOCK" file for virtual memory to create a text file editor. It would work like this: Load the text file into a block file, adding blocks as needed Edit the text file in the blocks Save the file back to DV80 format when you are done editing and delete block file. What do you think of that approach? Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted December 13, 2018 Author Share Posted December 13, 2018 You could probably do something like that. If I were to do that in fbForth, I would need to figure out how to handle lines because a block is 1024 characters with no delimiters except at the end of the block. A block is usually visualized as 16 64-character lines, but the block is filled with spaces when empty. That said, there is nothing preventing using block space in another way. We do it all the time with binary image blocks. I use blocks for program images on occasion. I did that for Walid’s plotter driver. You may know, but just to be sure, TurboForth and fbForth use DF128 files for blocks. Each block is 8 records in 4 sectors. fbForth uses 4 block buffers in low RAM space (same design as TI Forth, which has 5 buffers) with a single 128-byte record buffer in VRAM, whereas, TurboForth has its block buffers in VRAM, which, IIRC, are also the record buffers. I forgot how many block buffers TurboForth has (5 or 6?). TI Forth has 5 block buffers handled the same as fbForth but TI Forth reads/writes 4 sectors at a time without regard to file I/O, using a 1024-byte VRAM buffer. TurboForth may be faster with block I/O but does not manage bitmap graphics as do the other two Forths. Sorry, I am rambling... ...lee Quote Link to comment Share on other sites More sharing options...
Willsy Posted December 14, 2018 Share Posted December 14, 2018 Yes TF has 6 block buffers at power-up but you can change that with the #BUF variable. It's possible for TF to do bitmap (if the appropriate library were developed - I ran out of steam and talent!) but block operations would corrupt your screen. Likely not a major issue as most programs run from ram once they're loaded. Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted December 14, 2018 Author Share Posted December 14, 2018 Yes TF has 6 block buffers at power-up but you can change that with the #BUF variable. It's possible for TF to do bitmap (if the appropriate library were developed - I ran out of steam and talent!) but block operations would corrupt your screen. Likely not a major issue as most programs run from ram once they're loaded. I believe the “time” bit but not the “talent” bit. You are a very talented programmer! ...lee 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted December 17, 2018 Share Posted December 17, 2018 You could probably do something like that. If I were to do that in fbForth, I would need to figure out how to handle lines because a block is 1024 characters with no delimiters except at the end of the block. A block is usually visualized as 16 64-character lines, but the block is filled with spaces when empty. That said, there is nothing preventing using block space in another way. We do it all the time with binary image blocks. I use blocks for program images on occasion. I did that for Walid’s plotter driver. You may know, but just to be sure, TurboForth and fbForth use DF128 files for blocks. Each block is 8 records in 4 sectors. fbForth uses 4 block buffers in low RAM space (same design as TI Forth, which has 5 buffers) with a single 128-byte record buffer in VRAM, whereas, TurboForth has its block buffers in VRAM, which, IIRC, are also the record buffers. I forgot how many block buffers TurboForth has (5 or 6?). TI Forth has 5 block buffers handled the same as fbForth but TI Forth reads/writes 4 sectors at a time without regard to file I/O, using a 1024-byte VRAM buffer. TurboForth may be faster with block I/O but does not manage bitmap graphics as do the other two Forths. Sorry, I am rambling... ...lee I could probably use 128 bytes lines internally and then print them out to a text file when I save then using -TRAILING on each line. It will not be real fast to save but it would work. But I am considering making a 40 column editor without windowing so lines fit on the screen. Kind of like the original Forth used 64 column lines because that fit on the screen at the time. Is there a reason you use DF128 files and not DF256 (is 256 possible?) Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted December 17, 2018 Author Share Posted December 17, 2018 I could probably use 128 bytes lines internally and then print them out to a text file when I save then using -TRAILING on each line. It will not be real fast to save but it would work. But I am considering making a 40 column editor without windowing so lines fit on the screen. Kind of like the original Forth used 64 column lines because that fit on the screen at the time. If you have not set up block buffers à la figForth as with TI Forth, fbForth and TurboForth, there is no reason you could not devise your own, possibly more convenient scheme. You could set up block buffers that hold 16 80-character lines that use block files with 5 sectors/block. That would likely be less wasteful of RAM real estate, but, of course, require blocks files that are 5-sector (1280-byte) multiples. Is there a reason you use DF128 files and not DF256 (is 256 possible?) Yes. DF128 is the largest record size that uses the entire sector for data, i.e., there is no wasted space. DF256 is not possible because there is only a 1-byte space in the FDR for storing the bytes/record and storing 0 in the records/sector byte means that the file is a program file, which complicates reading the file. DF255 (I think that is possible) would only allow blocks of 1020 bytes, requiring an inconvenient line-handling algorithm. And, of course, with 64 characters per “line” and 128 as a multiple of 64, it is quite convenient. ...lee 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted December 17, 2018 Share Posted December 17, 2018 Ok thanks. I am looking at old code from HsForth for blocks in files. I should take a look at FB Forth too. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted December 18, 2018 Share Posted December 18, 2018 While scouring my old system from the 90s I found this code that I wrote to manage block source files. Some of it might have value for if you don't already have them. I always liked the "listing" word. I would run it to the printer and put the listings in my source code folder. And then run the .index and get a table of contents. So convenient. \ simple block editor words : <LINE> ( l# s# - addr #c ) BLOCK SWAP C/L @ * + 40 C/L @ ; : .LINE ( l# s# - ) <LINE> -TRAILING TYPE #LINE 1+! ; : LIST ( s# - ) CR DUP SCR ! ." SCR#" U. 10 0 DO CR I 3 .R SPACE I SCR @ .LINE LOOP CR ; : PP 0 TEXT PAD 1+ SWAP scr @ <LINE> CMOVE UPDATE ; : PL 0D EMIT OUT 0! C/L @ SPACES 0D EMIT [char] ? EMIT 0D EMIT DUP SCR @ <LINE> PAD 2dup C! 1+ SWAP CMOVE <IN$> 1+ SWAP scr @ <LINE> CMOVE UPDATE ; : .INDEX 0 SWAP .LINE ; \ scr - : CLEAR ( n -- ) BUFFER B/BUF BLANK UPDATE ; \ scr - : COPY ( n -- ) SAVE-BUFFERS SWAP BLOCK 2- ! UPDATE ; \ from to - : THRU ( 1st-block last-block -- ) 1+ SWAP DO I U. I LOAD LOOP ; : CR'S ( n -- ) 0 DO CR #LINE 1+! LOOP ; : FORM-FEED 0C EMIT #PAGE 1+! #LINE 0! ; : .PAGE# #PAGE @ IF ." page:" #PAGE @ 3 .R THEN ; : .HEADER CR ACTIVE $. TAB TAB TIME@ TIME->$ $. SPACE SPACE DATE@ DATE->$ $. ; : .FOOTER CR CR L/PAGE #LINE @ - CR'S 0F CTAB ." HS/FORTH V5.0" 10 SPACES ." Intelect Systems" CR 40 CTAB .PAGE# FORM-FEED ; : ?FORMFEED #LINE @ L/PAGE > IF .FOOTER .HEADER THEN ; : INDEX ( from,to -- ) DECIMAL HIGHBLK @ 1- MIN OVER L/PAGE / 1+ #PAGE ! \ calculate page# for 1st blk #LINE 0! .HEADER CR CR 1+ SWAP DO CR I 4 .R 4 SPACES I .INDEX ?FORMFEED 1 /LOOP .FOOTER ; : 3'S 3 / 3 * ; : TRIAD ( scr# -- ) DECIMAL #PAGE 0! .HEADER 3'S DUP 3 + SWAP DO CR I LIST LOOP .FOOTER ; : TRIADS ( from,to -- ) 3'S 1+ SWAP 3'S DO I TRIAD 3 +LOOP ; : LISTING 0 HIGHBLK @ 2 - TRIADS ; 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted December 18, 2018 Author Share Posted December 18, 2018 Somewhat similar stuff in TI Forth (Alternate I/O, block 72) and fbForth (Alternate I/O, block 19). ...lee Quote Link to comment Share on other sites More sharing options...
+TheBF Posted December 18, 2018 Share Posted December 18, 2018 I may have use that as a starting point. I can't remember. The guy that wrote HsForth hated blocks, so there was minimal support. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted January 5, 2019 Share Posted January 5, 2019 Space saving opportunity? Hi Lee, While I was looking at FBForth's block file code I found this: : R/W ( bufaddr block# flag --- ) IF RBLK ELSE WBLK THEN ; It appears to be used only twice. Once in the READ operation in BLOCK and once in WRITE operation in BUFFER. This appears to be a tradition in Fig Forth and I also see it in MVP Forth, by Glen Hayden, (circa 1983) which also has a form of this word controlled by a parameter on the stack. This seems to break the axiom "the dictionary is your case statement". HsForth, (circa 1990) removes the control parameter and simple puts the RBLK in the BLOCK word and the WBLK in the BUFFER word as does FPC by Tom Zimmer (circa 1988) and ZenForth by Martin Tracy (1989) It appears the Fig-Forth sacred tradition was removed by more contemporary authors. Perhaps you could put this on your stack for future changes to save some space. 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted January 5, 2019 Author Share Posted January 5, 2019 Yeah...That was mostly to avoid breaking anything in TI Forth user code and probably a little laziness, as well. ...lee 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted February 11, 2019 Author Share Posted February 11, 2019 My fbForth website (see in my signature) is pretty much up to date now. ...lee 4 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 11, 2019 Share Posted February 11, 2019 That's beautiful site Lee. 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted February 11, 2019 Author Share Posted February 11, 2019 That's beautiful site Lee. Thank you, kind Sir! I guess I should update the tickler thread in the parent sub-forum. ...lee 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted March 1, 2019 Author Share Posted March 1, 2019 I am beginning to work on porting Walid’s (@Vorticon’s) XB Stratego game to fbForth 2.0. The first thing I am doing is writing words to convert CALL SOUND() statements to standard sound lists and one or more blocks of same to a sound table that can be played with PLAY . It is really overkill for this game because there are not so many CALL SOUND() statements that it could not be done fairly easily by hand, but I have always wanted to do it. It would certainly be useful for larger tables. I may try to port @TheBF’s Camel99 Forth sound words of a year or so ago to do the trick. ...lee 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 1, 2019 Share Posted March 1, 2019 I am beginning to work on porting Walid’s (@Vorticon’s) XB Stratego game to fbForth 2.0. The first thing I am doing is writing words to convert CALL SOUND() statements to standard sound lists and one or more blocks of same to a sound table that can be played with PLAY . It is really overkill for this game because there are not so many CALL SOUND() statements that it could not be done fairly easily by hand, but I have always wanted to do it. It would certainly be useful for larger tables. I may try to port @TheBF’s Camel99 Forth sound words of a year or so ago to do the trick. ...lee If there are any pieces , small routines etc that you want to parcel out just let me know. Happy to write a few screens for you. It's a big game, but Walid's use of named routines gives a structure to begin with. I did a casual look at it and there are probably opportunities to create some custom data structures that make the Forth easier to grok. Multi-dimensional arrays are not the only way to represent some of the information from what I can see. I did implement some code to use the ISRHook to run the sound time delay in the background for the 4 voices to see how that worked. It was fine for small sound statements in my "scientific" sound library (HZ DB etc.) I remember thinking that I should try it with the sound player but did not get there. I will review the possibilities and get back to you. IMHO if we try to write the game in translated BASIC we will end up with something rather complicated in Forth. BASIC is remarkably good at doing what BASIC does. My experience in translating some BASIC demos here has shown me that Forth is not super at being BASIC, unless you write a BASIC in Forth first. :-) The ideal strategy is to create a "stratego" language of sorts and then write the game in that. Easier said than done for me since I don't know a thing about the game. :-) Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 1, 2019 Share Posted March 1, 2019 Here is my sound experiment using an ISR timer that counts down the time delay for each voice and then turns the voice off. The key to this is that the VOX* words set some variables to the correct address for each voice. I will have to look at the sound lists to see how a player would do this. I suppose the solution is to write the player in ALC and give it to the ISRHOOK. Hmm... \ TMS9919 SOUND CHIP DRIVER and CONTROL LEXICON Jan 2017 BJF \ Modified to use ISR timers to control durations Feb 16 2019 BJF NEEDS DUMP FROM DSK1.TOOLS \ debugging NEEDS MOV, FROM DSK1.ASM9900 \ TMS9919 is a memory mapped device on the TI-99 @ >8400 \ SND! is in the CAMEL99 Kernel as : SND! 8400 C! ; \ frequency code must be ORed with these numbers to create a sound HEX 8000 CONSTANT OSC1 A000 CONSTANT OSC2 ( oscillators take 2 nibbles) C000 CONSTANT OSC3 E0 CONSTANT OSC4 ( noise takes 1 nibble) \ Attenuation values are ORed with these values to change volume ( 0= max, 15 = off) 90 CONSTANT ATT1 B0 CONSTANT ATT2 D0 CONSTANT ATT3 F0 CONSTANT ATT4 ( OSC4 volume adjust) \ timer array: 1 for each voice CREATE TIMERS ( -- addr) 0 , 0 , 0 , 0 , \ names for each timer in the array TIMERS CONSTANT T1 T1 CELL+ CONSTANT T2 T2 CELL+ CONSTANT T3 T3 CELL+ CONSTANT T4 \ There are no 32 bit numbers in the CAMEL99 compilerBYE \ so we create a double variable with primtives : >DOUBLE ( addr len -- d ) 0 0 2SWAP >NUMBER 2DROP ; DECIMAL S" 111761" >DOUBLE CREATE f(clk) ( -- d) , , \ 32 bit int. \ >FCODE re-arranges freq. value nibbles (4bits) for the TMS9919 HEX CODE >FCODE ( 0abc -- 0cab) \ version by Farmer Potato Atariage 0B44 , \ TOS 4 SRC, \ C0AB C204 , \ TOS W MOV, \ DUP 0948 , \ W 4 SRL, \ 0C0A D108 , \ W TOS MOVB, \ 0CAB NEXT, \ 8 BYTES, 28 uS :-) ENDCODE \ we set the "ACTIVE CHANNEL" with these variables VARIABLE OSC \ holds the active OSC value VARIABLE ATT \ holds the active ATTENUATOR value VARIABLE T \ hold active timer address \ convert freq. to 9919 chip code DECIMAL : HZ>CODE ( freq -- fcode ) f(clk) 2@ ROT UM/MOD NIP >FCODE ; HEX \ **for testing** print sound data to screen AND make sound \ : SND! ( c -- ) ." >" BASE @ >R HEX DUP U. 8400 C! R> BASE ! ; \ Set the sound "GENerator that is active by assigning \ timer, attenuator and oscillator : GEN! ( osc att tmr -- ) T ! ATT ! OSC ! ; \ ================================================================ \ S C I E N T I F I C S O U N D C O N T R O L L E X I C O N \ sound generator selectors : VOX1 ( -- ) OSC1 ATT1 T1 GEN! ; : VOX2 ( -- ) OSC2 ATT2 T2 GEN! ; : VOX3 ( -- ) OSC3 ATT3 T3 GEN! ; : VOX4 ( -- ) OSC4 ATT4 T4 GEN! ; : NOISE ( n -- ) 0F AND VOX4 OSC @ OR SND! ; : (HZ) ( f -- n) HZ>CODE OSC @ OR ; \ convert freq. add OSC : (DB) ( level -- c) ABS 2/ 0F MIN ATT @ OR ; \ DB to attenuation : HZ ( f -- ) (HZ) SPLIT SND! SND! ; : DB ( level -- ) (DB) SND! ; \ Usage: -6 DB : TICKS ( time -- ) T @ ! ; \ DURATION : MUTE ( -- ) -30 DB 0 T @ ! ; : SILENT ( --) 9F SND! BF SND! DF SND! FF SND! ; CREATE TIMER-ISR R1 TIMERS LI, \ R1=timer array address R2 8400 LI, \ R2=sound port address R3 9F00 LI, \ R3=attenuator "off" value R5 TIMERS 4 CELLS + LI, \ compute last timer address R0 CLR, BEGIN, R1 ** R0 CMP, \ timer <>0 NE IF, R1 ** DEC, \ decrement timer EQ IF, R3 R2 ** MOVB, \ mute attenuator ENDIF, ENDIF, R1 INCT, \ next timer R3 2000 AI, \ next attenuator R1 R5 CMP, \ last timer? EQ UNTIL, RT, ENDCODE HEX : INSTALL 83C4 ! ; : BG-ON TIMER-ISR INSTALL ; : BG-OFF 0 INSTALL ; \ DECIMAL \ : TEST \ VOX1 120 HZ 0 DB 500 TICKS \ VOX2 241 HZ 0 DB 550 TICKS \ VOX3 482 HZ 0 DB 600 TICKS ; Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted March 1, 2019 Author Share Posted March 1, 2019 Brian... I am debating on how to handle this discussion of porting Stratego to fbForth 2.0—whether to break it out into its own thread; do it in a PM thread among you, Walid and me; or just keep it here in the main thread as I have done most times in the past (could be instructive to others passing through this thread). I will add you to the PM thread between Walid and me, in any event. I agree with your objections to a straight-up transliteration from Basic. At the moment, I have the initialization code and main program code in TidBit files, which Walid graciously donated. I also have programmed a quick and dirty port of the splash screen. Walid is working on a flowchart, but I do not wish to put pressure on a very busy guy so we can start with the TidBit files, which are a lot easier to work from than trying to use the TidBit-generated XB files. ...lee Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.