Implement tandy 3-voice support

break swine meeper trying to make it faster :/
This commit is contained in:
Jeremy Penner 2024-04-05 22:19:00 -04:00
parent 85f3767e1e
commit 17ae935409
12 changed files with 102 additions and 29 deletions

2
.gitignore vendored
View file

@ -3,3 +3,5 @@
*.dsk *.dsk
errors.txt errors.txt
*.sym *.sym
t.com

View file

@ -24,11 +24,14 @@
OUT 0x61 # AL OUT 0x61 # AL
NEXT NEXT
: slide ( div count + -- ) : slide ( freq count + -- )
>r begin over >spk 2 sleep-csec swap r@ + swap 1- dup not until >r swap freq>div swap begin over >spk 2 sleep-csec swap r@ + swap 1- dup not until
rdrop drop drop silence ; rdrop drop drop silence ;
: boop ( div count -- ) swap >spk sleep-csec silence ; : divboop ( count div ) >spk sleep-csec silence ;
: boop ( freq count -- ) swap freq>div divboop ;
: noise ( count -- ) : noise ( count -- )
begin rand >spk 1 sleep-csec 1- dup not until drop silence ; begin rand >spk 1 sleep-csec 1- dup not until drop silence ;
: arp ( d1 d2 count -- ) times each dup 1 boop swap next drop drop ; : spk-arp ( f1 f2 count -- ) times each dup 1 boop swap next drop drop ;
deferred arp spk-arp

View file

@ -13,8 +13,8 @@ import task.jrt
import iter.jrt import iter.jrt
import timer.jrt import timer.jrt
import beep.jrt import beep.jrt
import tandy.jrt
: !save ( v p -- ) openself >r dup >rot ! : !save ( v p -- ) openself >r dup >rot !
r@ if dup 0x100 - r@ seekto cell swap r@ fwrite <r close r@ if dup 0x100 - r@ seekto cell swap r@ fwrite <r close
else rdrop drop then ; else rdrop drop then ;

Binary file not shown.

View file

@ -16,8 +16,8 @@ var ms-error
: ms ms-error @ + 8 /mod ms-error ! delay ; : ms ms-error @ + 8 /mod ms-error ! delay ;
dbg" modem sounds" dbg" modem sounds"
array dtmf-col 1209 freq>div , 1336 freq>div , 1477 freq>div , array dtmf-col 1209 , 1336 , 1477 ,
array dtmf-row 697 freq>div , 770 freq>div , 852 freq>div , 941 freq>div , array dtmf-row 697 , 770 , 852 , 941 ,
( 0 1 2 ( 0 1 2
3 4 5 3 4 5
@ -39,25 +39,25 @@ array dtmf-row 697 freq>div , 770 freq>div , 852 freq>div , 941 freq>div ,
then then rdrop ; then then rdrop ;
: dialst ( st -- ) chars each i dialch next ; : dialst ( st -- ) chars each i dialch next ;
: dialtone [ 350 freq>div lit 440 freq>div lit ] 200 arp ; : dialtone 350 440 200 arp ;
: offhook noisy 30 sleep-csec 3 2 boop 15 sleep-csec 7 2 boop 10 sleep-csec ; : offhook noisy 30 sleep-csec 2 3 divboop 15 sleep-csec 2 7 divboop 10 sleep-csec ;
2100 freq>div const carrier-div 2100 const carrier-freq
980 freq>div const hs-low 980 const hs-low
1180 freq>div const hs-high 1180 const hs-high
1650 freq>div const hs2-low 1650 const hs2-low
1850 freq>div const hs2-high 1850 const hs2-high
: carrier-drop 0x6000 1 boop ; : carrier-drop 1 0x6000 divboop ;
: carrier ( csec -- ) carrier-div swap boop carrier-drop ; : carrier ( csec -- ) carrier-freq swap boop carrier-drop ;
: scramblebip ( div div -- ) rand 2 % if swap then drop 1 boop ; : scramblebip ( div div -- ) rand 2 % if swap then drop 1 boop ;
: hs-with-carrier ( csec -- ) : hs-with-carrier ( csec -- )
over-csec each carrier-div 1 boop hs-low hs-high scramblebip next ; over-csec each carrier-freq 1 boop hs-low hs-high scramblebip next ;
: dual-hs ( csec -- ) over-csec each : dual-hs ( csec -- ) over-csec each
hs-low hs-high scramblebip hs2-low hs2-high scramblebip hs-low hs-high scramblebip hs2-low hs2-high scramblebip
next ; next ;
: probe-hi ( csec -- ) [ 2400 freq>div lit 1200 freq>div lit ] <rot arp ; : probe-hi ( csec -- ) 2400 1200 <rot arp ;
: probe-lo ( csec -- ) [ 600 freq>div lit 300 freq>div lit ] <rot arp ; : probe-lo ( csec -- ) 600 300 <rot arp ;
: fullduplex ( csec -- ) : fullduplex ( csec -- )
over-csec each rand 3700 % 20 + freq>div >spk next silence ; over-csec each rand 3700 % 20 + freq>div >spk next silence ;
: handshake : handshake

Binary file not shown.

BIN
swine.com

Binary file not shown.

View file

@ -29,6 +29,14 @@ array board maxw maxh * allot
20 var, boardw 20 var, boardw
12 var, boardh 12 var, boardh
30 var, minecount 30 var, minecount
0xffff var, dirty-rows
: dirty! ( -- ) 0xffff dirty-rows ! ;
( mark both the current row and the row above, to ensure all borders are
redrawn )
: dirty-row! ( y -- ) 1 swap << dup 1 >> | dirty-rows @ | dirty-rows ! ;
: dirty-row? ( y -- f ) 1 swap << dirty-rows @ & ;
: draw-complete 0 dirty-rows ! ;
: board-lim boardw @ boardh @ * board + ; : board-lim boardw @ boardh @ * board + ;
: square-at ( x y -- p ) boardw @ * + board + ; : square-at ( x y -- p ) boardw @ * + board + ;
@ -244,9 +252,11 @@ dbg" board drawing"
.| boardw @ times each dup draw-square 1+ .| next drop next-row ; .| boardw @ times each dup draw-square 1+ .| next drop next-row ;
: draw-board ( -- ) 0 boxstyle! : draw-board ( -- ) 0 boxstyle!
col-grid col-bg boardx! boardy! draw-board-top col-grid col-bg boardx! boardy! draw-board-top
iterrows each i draw-row iterrows each i dirty-row? not if
i lastrow? not if draw-rowborder then i draw-row i lastrow? not if draw-rowborder then
next draw-board-bottom ; else
next-row i lastrow? not if next-row then
then next draw-board-bottom draw-complete ;
( general-purpose drawing ) ( general-purpose drawing )
dbg" general-purpose drawing" dbg" general-purpose drawing"
@ -321,21 +331,21 @@ dbg" game ui"
bl .- br ; bl .- br ;
: move-cursor ( dx dy -- ) : move-cursor ( dx dy -- )
cursy b@ + swap cursx b@ + swap 2dup valid-pos? cursy b@ dup dirty-row! + swap cursx b@ + swap 2dup valid-pos?
if cursy b! cursx b! else drop drop then ; if cursy b! cursx b! else drop drop then cursy b@ dirty-row! ;
: curs@ cursx b@ cursy b@ ; : curs@ cursx b@ cursy b@ ;
0x21 const %f 0x21 const %f
: await-command : await-command
wait-key key>scan wait-key key>scan
dup %esc = if leave then dup %esc = if leave dirty! then
dup %left = if -1 0 move-cursor then dup %left = if -1 0 move-cursor then
dup %right = if 1 0 move-cursor then dup %right = if 1 0 move-cursor then
dup %up = if 0 -1 move-cursor then dup %up = if 0 -1 move-cursor then
dup %down = if 0 1 move-cursor then dup %down = if 0 1 move-cursor then
dup %f = if curs@ flag-at then dup %f = if curs@ flag-at cursy b@ dirty-row! then
dup %enter = swap %space = or if curs@ reveal-at then ; dup %enter = swap %space = or if curs@ reveal-at dirty! then ;
: popupbox ( h -- ) : popupbox ( h -- )
20 8 textxy! 0 hstyle! 1 vstyle! 20 8 textxy! 0 hstyle! 1 vstyle!
@ -359,9 +369,9 @@ dbg" game ui"
: confirm-quit cancelled? if quitmenu col-bg clear then ; : confirm-quit cancelled? if quitmenu col-bg clear then ;
: draw-game draw-board draw-cursor ; : draw-game draw-board draw-cursor ;
: play enter col-bg clear : play enter col-bg clear dirty!
begin draw-game await-command confirm-quit in-progress? not until begin draw-game await-command confirm-quit in-progress? not until
draw-board display-result enter ; dirty! draw-board display-result enter ;
: start init-board boardw @ 2/ cursx b! boardh @ 2/ cursy b! play ; : start init-board boardw @ 2/ cursx b! boardh @ 2/ cursy b! play ;

58
tandy.jrt Executable file
View file

@ -0,0 +1,58 @@
:asm tnd! ( b -- )
POP AX
OUT 0xc0 # AL
NEXT
:asm tnd-vol! ( vol chan -- )
POP AX
MOV CL 5 #
SHL AX CL
POP CX
OR AL CL
OR AL 0x90 #
OUT 0xc0 # AL
NEXT
:asm tnd-note! ( note chan -- )
POP DX
MOV CL 5 #
SHL DX CL ( DL: channel mask )
POP BX ( BX: note )
( first command )
MOV AL 0x0f #
AND AL BL ( low 4 bits of divisor )
OR AL DL ( channel mask )
OR AL 0x80 # ( update frequency )
OUT 0xc0 # AL
( second command )
MOV AX BX
DEC CL ( shift by 4 )
SHR AX CL
AND AL 0x3f # ( wrap any divisor above 10 bits )
OUT 0xc0 # AL
NEXT
:asm freq>tnd ( f -- d )
MOV AX 0x9E99 #
MOV DX 0x36 #
POP BX
DIV BX
MOV CL 5 #
SHR AX CL
PUSH AX
NEXT
: tnd-silence 0xf 0 tnd-vol! 0xf 1 tnd-vol! ;
: tnd-2chord ( f1 f2 count -- )
>rot freq>tnd 0 tnd-note! freq>tnd 1 tnd-note!
0 0 tnd-vol! 0 1 tnd-vol!
sleep-csec tnd-silence ;
: set-tandy ( f -- ) if ' tnd-2chord else ' spk-arp then ' arp redefine ;
: detect-tandy 0xc000 0xf000 b@far 0x21 =
0xfffe 0xf000 b@far 0xfd = or ;
' init :chain detect-tandy set-tandy ;

Binary file not shown.

Binary file not shown.

Binary file not shown.