Implement tandy 3-voice support

break swine meeper trying to make it faster :/

.gitignore

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

beep.jrt

@@ -24,11 +24,14 @@
   OUT 0x61 # AL
   NEXT
 
-: slide ( div count + -- )
-  >r begin over >spk 2 sleep-csec swap r@ + swap 1- dup not until
+: slide ( freq count + -- )
+  >r swap freq>div swap begin over >spk 2 sleep-csec swap r@ + swap 1- dup not until
   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 -- ) 
   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
 

common.jrt

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

dialer.jrt

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

swine.jrt

@@ -29,6 +29,14 @@ array board maxw maxh * allot
 20 var, boardw 
 12 var, boardh
 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 + ;
 : 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 ;
 : draw-board ( -- ) 0 boxstyle!
   col-grid col-bg boardx! boardy! draw-board-top
-  iterrows each i draw-row 
-    i lastrow? not if draw-rowborder then 
-  next draw-board-bottom ;
+  iterrows each i dirty-row? not if 
+    i draw-row i lastrow? not if draw-rowborder then 
+  else
+    next-row i lastrow? not if next-row then
+  then next draw-board-bottom draw-complete ;
 
 ( general-purpose drawing )
 dbg" general-purpose drawing"
@@ -321,21 +331,21 @@ dbg" game ui"
   bl .- br ;
 
 : move-cursor ( dx dy -- )
-  cursy b@ + swap cursx b@ + swap 2dup valid-pos? 
-  if cursy b! cursx b! else drop drop then ;
+  cursy b@ dup dirty-row! + swap cursx b@ + swap 2dup valid-pos? 
+  if cursy b! cursx b! else drop drop then cursy b@ dirty-row! ;
 
 : curs@ cursx b@ cursy b@ ;
 
 0x21 const %f
 : await-command
   wait-key key>scan 
-  dup %esc   = if leave then
+  dup %esc   = if leave dirty! then
   dup %left  = if -1  0 move-cursor then 
   dup %right = if  1  0 move-cursor then
   dup %up    = if  0 -1 move-cursor then
   dup %down  = if  0  1 move-cursor then 
-  dup %f     = if curs@ flag-at then
-  dup %enter = swap %space = or if curs@ reveal-at then ;
+  dup %f     = if curs@ flag-at cursy b@ dirty-row! then
+  dup %enter = swap %space = or if curs@ reveal-at dirty! then ;
 
 : popupbox ( h -- )
   20 8 textxy! 0 hstyle! 1 vstyle! 
@@ -359,9 +369,9 @@ dbg" game ui"
 : confirm-quit cancelled? if quitmenu col-bg clear then ;
 : 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 
-  draw-board display-result enter ;
+  dirty! draw-board display-result enter ;
 
 : start init-board boardw @ 2/ cursx b! boardh @ 2/ cursy b! play ;
 

tandy.jrt

@@ -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 ;