'******************************************************************************
'* 
'* TMS9918 VIDEO EMULATION v.1.0 (VIDEO DEVICE) (internal implementation yet)
'*
'* Current emulation is not cycle-wise
'*
'* Supported platform/bus: several 8-bit
'*
'* Based on information from:
'*  - TMS9918A description by Sean Young (Version 0.4.2 September 2002)
'*  - The MSX Red Book (revised version 1997/08/06)
'* 
'* Version history:
'*  2007, 2009 - initial emulation (WadiM)
'*
'****************************************************************************** 

//DEBUG.ON 'uncomment to enable debug messages (can be slow for hi-freq events)
  //DIRECT.OFF 'uncomment to disable "direct" calls to internal implementation

'device interface support
public use object DEVICE

'internal implementation (direct)
public use internal "TMS9918"

//device name
DeviceName="TMS9918 Video"
DebugName="TMS9918_VID" 

'----------------------------- Video memory -----------------------------------

//Video memory (16Kb of internal memory)
use object MEMORY_BUFFER as vidmem : vidmem.Size=0x4000

'---------------------- Resulting image and palette ---------------------------

//Video bitmap
use object BITMAP_IMAGE as image
    image.Width=256 : image.Height=192

//Initial video palette 
dim Palette(16) as dword 		'Video pallette
    Palette(0x0)=RGB(1,2,3)             'transparent
    Palette(0x1)=RGB(0,0,0)             'black
    Palette(0x2)=RGB(33,200,66)         'green
    Palette(0x3)=RGB(94,220,120)        'light-green
    Palette(0x4)=RGB(84,85,237)         'dark-blue
    Palette(0x5)=RGB(125,118,252)       'light-blue
    Palette(0x6)=RGB(212,82,77)         'dark-red
    Palette(0x7)=RGB(66,235,245)        'cyan
    Palette(0x8)=RGB(252,85,84)         'red
    Palette(0x9)=RGB(255,121,120)       'light-red
    Palette(0xA)=RGB(212,193,84)        'dark-yellow
    Palette(0xB)=RGB(230,206,128)       'light-yellow
    Palette(0xC)=RGB(33,176,59)         'dark-green
    Palette(0xD)=RGB(201,91,186)        'purple
    Palette(0xE)=RGB(204,204,204)       'gray
    Palette(0xF)=RGB(255,255,255)       'white

//Update screen palette 
procedure UpdatePalette
 dim i as integer : for i=0 to 15 : image.Palette(i)=Palette(i) : next
end

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

//Write memory data port
public property MEM_PORT(Value as byte)
 ?? DebugPrefix;">MemPort=";Hex(Value,2);"h"
 MemPort=Value
end direct MemPort

//Read memory data port
public function MEM_PORT as byte
 result=MemPort
 ?? DebugPrefix;"<MemPort=";Hex(result,2);"h"
end direct MemPort

//Write memory address / registers port
public property REG_PORT(Value as byte)
 ?? DebugPrefix;">RegPort=";Hex(Value,2);"h"
 RegPort=Value
end direct RegPort

//Read state port
public function STATE_PORT as byte
 result=StatePort
 ?? DebugPrefix;"<StatePort=";Hex(result,2);"h"
end direct StatePort

'------------------------------ Rendering -------------------------------------

//Rendering event handler (50Hz by default)
function RenderEvent(freq as integer,eventid as dword) as boolean
 result=true 'need next event call
 'render screen only if something changed
 if (Changed) or (vidmem.Changed) then
  RenderScreen
  'output result
  pc.DrawScreen(image.Object) 
  Changed=false : vidmem.Changed=false
 end if
 'set vertical retrace IRQ 
 VBLANK=true : if IRQAllowed then pc.SetIRQ(0,true)
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

 //set initial data
 UpdatePalette 'palette
 InitInternal(vidmem.Object,image.Object) 'init internal inplementation

 //register 50Hz rendering event
 pc.NewFreqEvent(50)=RenderEvent '50Hz screen rendering

 //success
 result=true

end 

//Device finalization
public procedure DEV_DONE(stream as object)
 //clear bitmap
 image.height=0
 //parent call
 DEV_DONE(stream)
end

