'******************************************************************************
'* 
'* BK-0010/11 KEYBOARD CONTROLLER (CHIP DEVICE)
'*
'* Supported platform/bus: Soviet PDP-11 based home computers BK-0010/11
'*
'* WARNING: Not all keys processed yet
'*
'* Version history:
'*  2009 - initial emulation (by WadiM)
'*
'****************************************************************************** 

//DEBUG.ON 'uncomment to enable debug messages (can be slow for hi-freq events)

//constants
const IRQ_INDEX=0xC 'index of interrupt (*4=48d=060 - keyboard interrupt vector)
const MAX_BUFFER_SIZE=8 'max count of buffered scancodes
const AUTOREPEAT_ENABLED=true 'emulate autorepeat pressed key feature
const AUTOREPEAT_DELAY_FREQ  as word=2   'deley before key autorepeat, Hz
const AUTOREPEAT_REPEAT_FREQ as word=20  'key autorepeat time, Hz

//device interface support
public use object DEVICE

//device name
DeviceName="BK Keyboard"
DebugName="KEYB"

//Matrix of virtual key states
dim vkey_state(256) as boolean 'pressed/released currently

//Keyboard buffer
use object FIFO_STREAM as buffer

//Variables
dim IRQEnabled as boolean=false 'can raise IRQ if key present 
dim KEYPresent as boolean=false 'key present in buffer
dim LastKeyCode as byte=0 'last key code, obtained from buffer
dim LastKeyPressed as boolean=false 'last key was pressed or released
dim HasKeyPressed as boolean=false 'last key was pressed or released
dim LastPressedCode as byte=0 'last pressed key code (to autorepeat)
dim IRQPending as boolean=false 'need raise IRQ if key present 

'-------------------------------- H/W Interface -------------------------------

//Is some keys pressed at this moment 
public function HasPressedKeys as boolean
 result=LastKeyPressed  

 //TODO - commented stuff is first try to fix selection in "Exolon" menu
 //! This game read "pressed key" flag on splash screen, but not read key
 //! value from data register after it. So in menu this key (pressed on
 //! splash screen) 'll be readed, not newly pressed key. Need to make
 //! more exact keyboard emulation to pass it.   

 /* if not dbg.ReadingMemory then 
 if buffer.size>0 then : result=false
    if KeyPresent then : KeyPresent=false
    pc.SetIRQ(IRQ_INDEX,false) : end if
 end if : end if 
 */
end

//Write state register (byte index: 0-word, 1-low, 2-high)
public property STATE_REG(ByteIndex as byte,Value as word)
 select case ByteIndex
 case 0 'whole word
  ?? DebugPrefix;">StateReg=";Hex(Value,4);"h"
  IRQEnabled=(Value and 0x40)=0 'bit 6
 case 1 'low byte
  ?? DebugPrefix;">StateRegLow=";Hex(Value,2);"h"
  IRQEnabled=(Value and 0x40)=0 'bit 6
 case 2 'high byte
  ?? DebugPrefix;">StateRegHigh=";Hex(Value,2);"h"
 end select
end

//Read state register (byte index: 0-word, 1-low, 2-high)
public function STATE_REG(ByteIndex as byte) as word
 result=0 : select case ByteIndex
 case 0 'whole word
  if not IRQEnabled then result=result or 0x40
  if KeyPresent then result=result or 0x80
  ?? DebugPrefix;"<StateReg=";Hex(result,4);"h"
 case 1 'low byte
  if not IRQEnabled then result=result or 0x40
  if KeyPresent then result=result or 0x80
  ?? DebugPrefix;"<StateRegLow=";Hex(result,2);"h"
 case 2 'high byte
  ?? DebugPrefix;"<StateRegHigh=";Hex(result,2);"h"
 end select
end

//Read data register (byte index: 0-word, 1-low, 2-high)
public function DATA_REG(ByteIndex as byte) as word
 select case ByteIndex
 case 0 'whole word
  result=LastKeyCode : if (KEYPresent) and (not dbg.ReadingMemory) then 
  KEYPresent=false : pc.SetIRQ(IRQ_INDEX,false) : end if
  ?? DebugPrefix;"<DataReg=";Hex(result,4);"h"
 case 1 'low byte
  result=LastKeyCode : if (KEYPresent) and (not dbg.ReadingMemory) then 
  //dbg.break
  KEYPresent=false : pc.SetIRQ(IRQ_INDEX,false) : end if

  ?? DebugPrefix;"<DataRegLow=";Hex(result,2);"h"
 case 2 'high byte
  result=0 : ?? DebugPrefix;"<DataRegHigh=";Hex(result,2);"h"
 case else : result=0 : end select
end

'---------------------------- Keys Processing --------------------------------

//Autorepeat event
dim eventid_repeat as dword=0 'event identifier of autorepeat event
function RepeatEvent(freq as integer,eventid as dword) as boolean
 if eventid=eventid_repeat then //make event
    if buffer.size<MAX_BUFFER_SIZE then buffer.PushByte(LastPressedCode) 
    result=true 'need next event
 else : result=false : end if
end

//Delay autorepeat event
dim eventid_delay as dword=0 'event identifier of delay autorepeat event
function DelayEvent(freq as integer,eventid as dword) as boolean
 if eventid=eventid_delay then //make event
    pc.NewFreqEvent(AUTOREPEAT_REPEAT_FREQ,eventid_repeat)=RepeatEvent
 end : result=false 'no more need delay event
end

//Handle key from emulator
public procedure HandleKey(vkey as byte, pressed as boolean)
 ?? DebugPrefix;">VKey=";Hex(vkey,2);"h (";iif(pressed,"DOWN","UP");")"
 eventid_repeat=eventid_repeat+1 : eventid_delay=eventid_delay+1
 LastKeyPressed=false
 if (pressed) and (buffer.size<MAX_BUFFER_SIZE) then 
   dim code as integer=-1
   select case vkey
    case VK_BACK    	: code=24
    case VK_RETURN  	: code=10
    case VK_HOME    	: code=19
    case VK_SPACE   	: code=32
    case VK_LEFT    	: code=8
    case VK_RIGHT   	: code=25
    case VK_UP      	: code=26
    case VK_DOWN      	: code=27
    case VK_A to VK_Z 	: code=65+(vkey-VK_A)
    case VK_0 to VK_9 	: code=48+(vkey-VK_0)
   end select
   if code>=0 then : LastPressedCode=code and 0x7F
      LastKeyPressed=true 
      buffer.PushByte(LastPressedCode) 
      if AUTOREPEAT_ENABLED then 
         eventid_repeat=eventid_repeat+1 : eventid_delay=eventid_delay+1 
         pc.NewFreqEvent(AUTOREPEAT_DELAY_FREQ,eventid_delay)=DelayEvent
   end if :  end if
 end if
end

//Keys processing event (take from buffer, put to register, raise IRQ)
function KeysEvent(freq as integer,eventid as dword) as boolean
 result=true 'need next event
 //read next key from buffer
 if (not KEYPresent) and (buffer.size>0) then
    LastKeyCode=buffer.PopByte and 0x7F 
    KEYPresent=true : IRQPending=true
//   dbg.break
 end if
 //try to raise IRQ if needed
 if (KeyPresent) and (IRQPending) and (IRQEnabled) then 
    IRQPending=pc.SetIRQ(IRQ_INDEX,true)
 end if
end

'---------------------------- DEVICE Interface --------------------------------

//Device initialization
public function DEV_INIT(stream as object,byref EventFreq as integer) as boolean

 'parent call
 if not DEV_INIT(stream,EventFreq) then exit(false)
 if EventFreq<100 then EventFreq=100

 //register events
 pc.NewFreqEvent(200)=KeysEvent '50Hz - sufficient for keyboard

 //success
 result=true

end 

       
