'******************************************************************************
'* 
'* VECTOR-6C VIDEO EMULATION (VIDEO DEVICE)
'*
'* Current emulation is not cycle-wise
'*
'* Supported platform/bus: Vector-6C
'* 
'* Version history:
'*  2009 - initial emulation (by WadiM)
'*
'****************************************************************************** 

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

'device interface support
public use object DEVICE

//device name
DeviceName="Vector-6C Video"
DebugName="VIDEO" 

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

//Video memory page 0 (0x8000-0x9FFF)
use object MEMORY_BUFFER as vidmem0 : vidmem0.Size=0x2000 
    vidmem0.BaseAddress=0x8000 : vidmem0.AddressRange=0x1FFF
    vidmem0.AddressMask=0x1FFF : vidmem0.AddressOffset=0

//Video memory page 1 (0xA000-0xBFFF)
use object MEMORY_BUFFER as vidmem1 : vidmem1.Size=0x2000 
    vidmem1.BaseAddress=0xA000 : vidmem1.AddressRange=0x1FFF
    vidmem1.AddressMask=0x1FFF : vidmem1.AddressOffset=0

//Video memory page 2 (0xC000-0xDFFF)
use object MEMORY_BUFFER as vidmem2 : vidmem2.Size=0x2000 
    vidmem2.BaseAddress=0xC000 : vidmem2.AddressRange=0x1FFF
    vidmem2.AddressMask=0x1FFF : vidmem2.AddressOffset=0

//Video memory page 3 (0xE000-0xFFFF)
use object MEMORY_BUFFER as vidmem3 : vidmem3.Size=0x2000 
    vidmem3.BaseAddress=0xE000 : vidmem3.AddressRange=0x1FFF
    vidmem3.AddressMask=0x1FFF : vidmem3.AddressOffset=0

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

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

//Initial video palette //TODO - currently Spectrum-like :)
dim Palette(16) as dword 		'Video pallette
    Palette(0x0)=RGB(0,0,0) 		'black 
    Palette(0x1)=RGB(0,0,192)	 	'blue
    Palette(0x2)=RGB(192,0,0) 		'red
    Palette(0x3)=RGB(192,0,192) 	'purple
    Palette(0x4)=RGB(0,192,0) 		'green
    Palette(0x5)=RGB(0,192,192) 	'cyan
    Palette(0x6)=RGB(192,192,0) 	'yellow
    Palette(0x7)=RGB(192,192,192) 	'gray
    Palette(0x8)=RGB(0,0,0) 		'black
    Palette(0x9)=RGB(0,0,255)	 	'bright-blue
    Palette(0xA)=RGB(255,0,0) 		'bright-red
    Palette(0xB)=RGB(255,0,255) 	'bright-purple
    Palette(0xC)=RGB(0,255,0) 		'bright-green
    Palette(0xD)=RGB(0,255,255) 	'bright-cyan
    Palette(0xE)=RGB(255,255,0) 	'bright-yellow
    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 -------------------------------

//Read/Write video memory page 0
public function ReadMemory0 alias vidmem0.ReadMemory
public function WriteMemory0 alias vidmem0.WriteMemory

//Read/Write video memory page 1
public function ReadMemory1 alias vidmem1.ReadMemory
public function WriteMemory1 alias vidmem1.WriteMemory

//Read/Write video memory page 2
public function ReadMemory2 alias vidmem2.ReadMemory
public function WriteMemory2 alias vidmem2.WriteMemory

//Read/Write video memory page 3
public function ReadMemory3 alias vidmem3.ReadMemory
public function WriteMemory3 alias vidmem3.WriteMemory

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

//Rendering of video memory to bitmap
procedure RenderScreen
 //variables
 dim x as integer, y as integer, i as integer, pos as integer=0
 dim b0 as byte, b1 as byte, b2 as byte, b3 as byte, b4 as byte
 dim b5 as byte, b6 as byte, b7 as byte, i64 as int64
 image.pos=0 
 //rendering
 for y=0 to 255 : pos=255-y : for x=0 to 31 //blocks 1x8
    'read 8-pixel blocks
    b0=vidmem0.Byte(pos) : b1=vidmem1.Byte(pos)
    b2=vidmem2.Byte(pos) : b3=vidmem3.Byte(pos)
    pos=pos+256
    'decode palette indexes and write pixels
    i64=InterleaveByteBits(b0,b1,b2,b3)
    UnpackInt64ToBytes(i64,b7,b6,b5,b4,b3,b2,b1,b0)
    image.WritePalPixels(b0,b1,b2,b3,b4,b5,b6,b7)
 next x : next y
 //mark memory unchanged
 vidmem0.Changed=false : vidmem1.Changed=false
 vidmem2.Changed=false : vidmem3.Changed=false
end

//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 vidmem0.Changed or vidmem1.Changed or vidmem2.Changed or vidmem3.Changed then
  RenderScreen
  'output result
  pc.DrawScreen(image.Object) 
 end if
 'set vertical retrace IRQ 
 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

 //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

