'******************************************************************************
'* 
'* SPECTRUM VIDEO EMULATION (ULA) v.1.0 (VIDEO DEVICE)
'*
'* Introduced in ZX Spectrum family of home computers
'* Current emulation is not cycle-wise (so not support multicolor etc)
'*
'* Supported platform/bus: Spectrum
'* 
'* Version history:
'*  v.1.0 - initial emulation (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="Spectrum Video"
DebugName="VID_SPEC" 

//Variables
dim BlinkFlag as boolean 'flag of blinking attributes

//Video memory ($4000-$5AFF)
use object MEMORY_BUFFER as vidmem 
    //permanent params
    vidmem.Size=0x1B00
    vidmem.BaseAddress=0x4000
    vidmem.AddressRange=0x1B00
    vidmem.AddressMask=0xFFFF
    vidmem.AddressOffset=0

//Pixel decoder (used to store current palette)
use object PIXEL_DECODER as pix

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

//Palette 
/* 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,192) 	'bright-cyan
    Palette(0xE)=RGB(255,255,0) 	'bright-yellow
    Palette(0xF)=RGB(255,255,255) 	'white 
*/

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 : pix.Palette(i)=Palette(i) : next
end

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

//Write video memory
public function WriteMemory alias vidmem.WriteMemory

//Read memory
public function ReadMemory alias vidmem.ReadMemory

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

//Precalculation of video buffer screen positions 
use object MEMORY_STREAM as scr_pos : scr_pos.Size=192*32*4 'packed positions of mask and attr
dim y as integer, i as integer, mask_pos as word, attr_pos as word
scr_pos.Pos=0 : for y=0 to 191 : for i=0 to 31 //blocks 1x8
 mask_pos=shl(Y and 0xF8,2)+shl(Y and 7,8)+shl(Y and 0xC0,5)-shl(Y and 0xC0,2)+i
 attr_pos=0x1800+i+shl(shr(y,3),5) : scr_Pos.Word=mask_pos : scr_Pos.Word=attr_pos 
next i : next y 

//Precalculation of video buffer screen positions 
dim scrpos(192*32*2) as word 'packed positions of mask and attr
dim ps as integer=0
for y=0 to 191 : for i=0 to 31 //blocks 1x8
 mask_pos=shl(Y and 0xF8,2)+shl(Y and 7,8)+shl(Y and 0xC0,5)-shl(Y and 0xC0,2)+i
 attr_pos=0x1800+i+shl(shr(y,3),5) : 
 scrpos(ps)=mask_pos : scrpos(ps+1)=attr_pos : ps=ps+2
next i : next y 

//Rendering of video buffer to bitmap
procedure RenderScreen
 //variables
 dim x as integer, y as integer, i as integer, pos as integer
 dim mask as byte, attr as byte, fgcolor as byte, bgcolor as byte, b as byte
 //change image size, if needed
 vidmem.Changed=false 'mark video memory not changed 
 scr_pos.Pos=0 : ps=0 'start of precalculated screen positions
 for y=0 to 191 : x=7 : for i=0 to 31 //blocks 1x8
    mask=vidmem.Byte(scr_Pos.Word) : attr=vidmem.Byte(scr_Pos.Word)
    //foreground and background colors
    fgcolor=attr and 7 : bgcolor=shr(attr,3) and 7
    //brightness
    if (attr and 0x40)<>0 then : fgcolor=fgcolor+8 : bgcolor=bgcolor+8 : end
    //blinking/inversion 
    if ((attr and 0x80)<>0) and (BlinkFlag) then 
       b=fgcolor : fgcolor=bgcolor : bgcolor=b : end
    //render bitmask 1x8
    image.DrawBitMask(x,y,-8,1,mask,Palette(fgcolor),Palette(bgcolor))
    x=x+8
 next i : next y
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 (vidmem.Changed) then
  RenderScreen
  'output result
  pc.DrawScreen(image.Object) 
 end if
 'set vertical retrace IRQ 
 pc.SetIRQ(0,true)
end

//Inversion blink event (2Hz by default)
function BlinkEvent(freq as integer,eventid as dword) as boolean
 result=true 'need next event call
 BlinkFlag=not(BlinkFlag) : vidmem.Changed=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
 BlinkFlag=false 'blinking attribute flag
 UpdatePalette 'palette

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

 //success
 result=true

end 

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

