diff --git a/asm.jrt b/asm.jrt index 8790877..21013b9 100755 --- a/asm.jrt +++ b/asm.jrt @@ -86,7 +86,8 @@ array patchtable 10 2 cells * allot : L! [ ' ' , ] 2 cells + target swap ! ; array anonlabels 10 cells allot -: <@ ( labelid -- ) cells anonlabels + @ @+ ; +: L<@ ( labelid -- addr ) cells anonlabels + @ ; +: <@ ( labelid -- ) L<@ @+ ; : :> ( labelid -- ) cells anonlabels + target swap ! ; : memreg create , does> @ oparg-base ! oparg-complete! ; diff --git a/assemble.com b/assemble.com index a2a8abf..f49ac7f 100755 Binary files a/assemble.com and b/assemble.com differ diff --git a/assemble.jrt b/assemble.jrt index 1373d40..379713f 100755 --- a/assemble.jrt +++ b/assemble.jrt @@ -5,9 +5,7 @@ s" asm.jrt" loadfile :init segalloc ' comseg redefine ; : writecom ( filename -- ) - overwrite >r 0x100 - begin dup target < while dup b@t r@ fputc 1+ repeat - drop r target 0x100 - 0x100 r@ comseg farfwrite r here 0x100 - 0x100 r@ fwrite t w>t w>t w>t w>t ; : defembed ( filename desc -- ) - over [ tdict-lookup open drop , ] filebytes target embed-bytes + over T] open target swap embed-file t' embed-size t' embed-write deffile ; : deffake ( filename desc size -- ) t' noop t' rand-write deffile ; } @@ -160,8 +160,54 @@ import embed.jrt : write-file ( file -- ) dup filename overwrite >r r@ over filedata > ( st ch -- st+1 ) over b! 1+ ; +: digit>> ( st state n div -- st state n ) + /mod swap dup if ( st state n digit ) + $0 + >r > ( state n st ) + > >rot then then ; +: nsep>> ( st state n -- st state n ) + over if > >rot then ; +: n>st ( n -- st ) + numstr 0 > 1000 digit>> nsep>> 100 digit>> 10 digit>> + swap drop $0 + char>> 0 char>> drop numstr ; + +: draw-download-progress ( size progress -- ) + 12 12 textxy! dup n>st draw-text + swap 40 / / 20 12 textxy! 0xb2 draw-hrepeat ; + +: download-file ( file -- ) dup write-file + >r textstate st draw-text + 20 12 textxy! 40 0xb0 draw-hrepeat + 2dup draw-download-progress + 30 delay + begin 15 delay 256 rand 0x1f & + + 2dup > while + 2dup draw-download-progress repeat + drop dup draw-download-progress 60 delay restore textstate! ; + dbg" BBSes" +: tolower ( ch -- ch ) + dup [ key A lit ] >= over [ key Z lit ] <= and + if [ key a key A - lit ] + then ; + +: readch ( -- ch ) + begin sleep-key key>ch dup printable? not while drop repeat ; + +: inputch readch tolower dup emit nl ; + : xmit-screen ( rle -- ) rle-decode textpen @ (( each i 8 >> textpen ! pass next )) xmit-iter @@ -171,8 +217,6 @@ dbg" BBSes" import rick.jrt dbg" menu" -: snapshot 1 0 pagecopy ; : restore 0 1 pagecopy ; - var menu-onclose : close-menu ( cp -- ) menu-onclose ! restore suspend ; : menu-options (( @@ -307,5 +351,5 @@ var curr-logobit ' go ' main redefine dbg" saving" +{ here s", dialer.com" s" dialtest.com" writeenv } -{ s" dialer.com" writecom } diff --git a/dialtest.com b/dialtest.com new file mode 100755 index 0000000..3609993 Binary files /dev/null and b/dialtest.com differ diff --git a/embed.jrt b/embed.jrt index 6e40052..0e5152b 100755 --- a/embed.jrt +++ b/embed.jrt @@ -35,12 +35,14 @@ var rle-run : encode-rle ( call with iterator that returns bytes ) >rle-start each i iterate if i 8 << | >rle else drop then next >rle-done ; : embed-rle ( host-filename -- ) open filebytes encode-rle ; -: embed-bytes ( -- ) target 0 w>t each i >t next target swap !t ; -: embed ( host-filename -- ) open filebytes embed-bytes ; +: embed-file ( fp -- ) + >r target 0 w>t 0xffff target r@ T] fread arg (( dup @ swap cell + +arg ( pend p ) diff --git a/file.jrt b/file.jrt index c5299e0..68ca5b0 100755 --- a/file.jrt +++ b/file.jrt @@ -55,24 +55,36 @@ NEXT 0 VAR, fcount -:ASM fread +:ASM farfread + POP DS ( seg ) +0 :> MOV AH 0x3f # POP BX ( fp ) POP DX ( buffer ) POP CX ( length ) INT 0x21 # + MOV BX CS + MOV DS BX MOV t& fcount @+ AX ( save number of bytes read ) NEXT -:ASM fwrite +DEF fread 0 L<@ w>t + +:ASM farfwrite + POP DS ( seg ) +0 :> MOV AH 0x40 # POP BX ( fp ) POP DX ( buffer ) POP CX ( length ) INT 0x21 # + MOV BX CS + MOV DS BX MOV t& fcount @+ AX ( save number of bytes written ) NEXT +DEF fwrite 0 L<@ w>t + -1 CONST EOF 0 VAR, fbuffer :t fgetc ( fp -- c ) diff --git a/jort.com b/jort.com index 84d3e47..c9e859e 100755 Binary files a/jort.com and b/jort.com differ diff --git a/rick.jrt b/rick.jrt index 35eb61e..57ec037 100755 --- a/rick.jrt +++ b/rick.jrt @@ -1,76 +1,60 @@ +dbg" Rick's Clubhouse BBS" array rick-welcome-rle { s" rickclub.bin" open filebytes 18 lines-of encode-rle } array rick-menu-rle { s" rickmenu.bin" open filebytes 7 lines-of encode-rle } +dbg" login" : login l" To login as a guest, leave your name blank." begin x" Enter your name: " readline nl dup b@ while x" Sorry, I don't recognize " xmit l" !" nl repeat nl + cyan fg! l" Welcome, guest! We hope you decide to apply for a full membership." l" Guest accounts have limited access." l" If you have any questions, feel free to page the sysop - I'll be happy" l" to chat with you if I'm around!" l" -- Rick" nl ; -: tolower ( ch -- ch ) - dup [ key A lit ] >= over [ key Z lit ] <= and - if [ key a key A - lit ] + then ; -: readch ( -- ch ) - begin sleep-key key>ch dup printable? not while drop repeat ; - deferred rick-menu noop : page-rick - l" Paging Sysop........" - 500 delay - l" Sorry, guess he's not home!" + x" Paging Sysop..." + 5 times each 100 delay [ key . lit ] emit next nl + l" Sorry, guess they're not home!" ' rick-menu ; -dbg" swine.com" s" swine.com" +dbg" files" +s" swine.com" s" Swine Meeper - A fun freeware puzzler. Find all the truffles!" defembed swine.com -dbg" dirtrect.com" s" dirtrect.com" -s" Dirty Rectangles - A simple textmode graphics demo" +s" dirtrect.com" +s" A simple textmode graphics demo advertising the game development collective\called Dirty Rectangles." defembed dirtrect.com -dbg" kpshrink4.kps" s" kpshrink4.kps" +s" assemble.com" +s" I think this is an 8086 assembler, but I don't have any documentation for\it and it doesn't use a standard syntax. Some kind of Forth system?" +defembed assemble.com + +( +s" kpshrink4.kps" s" KP Shrinker 4.0 - Compressor and decompressor for KPS files\Requires an earlier version of PK Shrinker to extract." 59943 deffake kpshrink4.kps -dbg" mazecr3d.kps" s" mazecr3d.kps" +s" mazecr3d.kps" s" Maze Crazy 3D - Explore a fascinating maze filled with twists and turns\in 3 incredible dimensions! Includes instructions for building a PC adapter\for the Virtua Glove." 48371 deffake mazecr3d.kps +) : rick-filelist (( - kpshrink4.kps yield - dirtrect.com yield - mazecr3d.kps yield swine.com yield + dirtrect.com yield + assemble.com yield )) ; -: xmit-desc ( st -- ) - chars (( each i [ key \ lit ] = if nl else pass then next )) - xmit-iter ; - -array numstr 7 allot -key 0 const $0 -: char>> ( st ch -- st+1 ) over b! 1+ ; -: digit>> ( st state n div -- st state n ) - /mod swap dup if ( st state n digit ) - $0 + >r > ( state n st ) - > >rot then then ; -: nsep>> ( st state n -- st state n ) - over if > >rot then ; -: n>st ( n -- st ) - numstr 0 > 1000 digit>> nsep>> 100 digit>> 10 digit>> - swap drop $0 + char>> 0 char>> drop numstr ; - : list-files 1 each blue bg! yellow fg! x" [" dup .digit x" ]" lcyan fg! black bg! sp emit i filename xmit @@ -78,20 +62,20 @@ key 0 const $0 lgray fg! nl i filedesc xmit-desc nl nl 1+ next drop ; -: inputch readch tolower dup emit nl ; - -: download-file ( file -- ) write-file ; ( todo: more elaborate ) : select-file x" Type the number of a file, or Q to return to the menu: " inputch dup [ key q lit ] = if drop ' rick-menu return then [ key 1 lit ] - dup 0 >= over rick-filelist count < and if - rick-filelist nth + rick-filelist nth lblue fg! x" Downloading " dup filename xmit l" ..." - download-file l" Done!" ' rick-menu return then - drop lred fg! l" Sorry, that is not a valid selection." ' select-file ; + download-file l" Done!" else + drop lred fg! l" Sorry, that is not a valid selection." then + ' select-file ; : rick-files nl rick-filelist list-files ' select-file ; +dbg" menu" + :noname ( -- cp ) nl rick-menu-rle xmit-screen nl 0 begin diff --git a/tinyjort.com b/tinyjort.com index ff06f73..7e84c53 100755 Binary files a/tinyjort.com and b/tinyjort.com differ diff --git a/zipoff.com b/zipoff.com index 32c449b..223dda0 100755 Binary files a/zipoff.com and b/zipoff.com differ diff --git a/zipoff.jrt b/zipoff.jrt index 1021ab9..b51a545 100755 --- a/zipoff.jrt +++ b/zipoff.jrt @@ -39,6 +39,7 @@ array $DOFAR asm-com : tdict-lookup word tdict dict-lookup ; +: T] tdict-lookup not if err return then state if , then ; immediate : te tdict-lookup interpretword ; immediate : tlookup ( -- tcp ) tdict-lookup not if dup err then cell + @ ; : t' tlookup interpretnumber ; immediate @@ -144,20 +145,21 @@ dbg" CREATE" var comfilename -: readcom ( filename ) open 0x100 target! - begin dup fgetc dup EOF != while >t repeat drop close ; +: readcom ( filename ) open >r + 0x100 0xffff over r@ comseg farfread + fcount @ + target!