07-10-2022, 10:13 PM
Next up is I/O emulation:
Code: (Select All)
def SYSTEM_BUS_T.sub__blink(onoff as integer)
if (onoff = 1) then
H3C0_blink_enable = 1
else
H3C0_blink_enable = 0
end if
end def
proc SYSTEM_BUS_T.func__blink() as integer
return -H3C0_blink_enable
end proc
def SYSTEM_BUS_T.sub_out(port as integer, data_out as integer)
if (new_error) then
return
end if
unsupported_port_accessed = 0
port = port and 65535
data_out = data_out and 255
if (port = &H3C0) then
H3C0_blink_enable = data_out and (1 shl 3)
goto done
end if
if (port = &H3C7) then '&H3C7, set palette register read index
H3C7_palette_register_read_index = data_out
H3C9_read_next = 0
goto done
end if
if (port = &H3C8) then '&H3C8, set palette register write index
H3C8_palette_register_index = data_out
H3C9_next = 0
goto done
end if
' alpha =$C005(49157)
' red =$C002(49154)
' green =$C003(49155)
' blue =$C003(49156)
' fg_color =$C0C9(49353)
' bg_color =$C0CA(49354)
if (port = &H3C9) then ' &H3C9, set palette color
data_out = data_out and 63
if (write_page->pal) then ' avoid NULL pointer
if (H3C9_next = 0) then ' red
write_page->pal[H3C8_palette_register_index] = &HFF00FFFF _
and write_page->pal[H3C8_palette_register_index]
write_page->pal[H3C8_palette_register_index] += _
(qbr(cast(double,data_out * 4.063492d - 0.4999999d)) shl 16)
computer.cpu_mos6510->mem->poke64(49154,data_out)
end if
if (H3C9_next = 1) then ' green
write_page->pal[H3C8_palette_register_index] = &HFF00FFFF _
and write_page->pal[H3C8_palette_register_index]
write_page->pal[H3C8_palette_register_index] += _
(qbr(cast(double,data_out * 4.063492d - 0.4999999d)) shl 8)
computer.cpu_mos6510->mem->poke64(49155,data_out)
end if
if (H3C9_next = 2) then ' blue
write_page->pal[H3C8_palette_register_index] = &HFF00FFFF _
and write_page->pal[H3C8_palette_register_index]
write_page->pal[H3C8_palette_register_index] += _
(qbr(cast(double,data_out * 4.063492d - 0.4999999d)))
computer.cpu_mos6510->mem->poke64(49156,data_out)
end if
end if
H3C9_next = H3C9_next + 1
if (H3C9_next = 3) then
H3C9_next = 0
H3C8_palette_register_index = H3C8_palette_register_index + 1
H3C8_palette_register_index = &HFF and H3C8_palette_register_index
end if
goto done
end if
unsupported_port_accessed = 1
done:
return
error_ret:
error(5)
end def
proc SYSTEM_BUS_T.func_inp(port as integer) as integer
static as integer value
unsupported_port_accessed = 0
if ((port > 65535) or (port < -65536)) then
error(6)
return 0 ' Overflow
end if
port = port and &HFFFF
if (port = &H3C9) then ' read palette
if (write_page->pal) then ' avoid NULL pointer
' convert 0-255 value to 0-63 value
if (H3C9_read_next = 0) then ' red
value = qbr_double_to_long(((cast(double,((write_page->pal[H3C7_palette_register_read_index] _
shr 16) and 255))) / 3.984376 - 0.4999999d))
end if
if (H3C9_read_next = 1) then ' green
value = qbr_double_to_long(((cast(double,((write_page->pal[H3C7_palette_register_read_index] _
shr 8) and 255))) / 3.984376 - 0.4999999d))
end if
if (H3C9_read_next = 2) then ' blue
value = qbr_double_to_long((cast(double,((write_page->pal[H3C7_palette_register_read_index] _
and 255))) / 3.984376 - 0.4999999d))
end if
H3C9_read_next = H3C9_read_next + 1
if (H3C9_read_next = 3) then
H3C9_read_next = 0
H3C7_palette_register_read_index = H3C7_palette_register_read_index + 1
H3C7_palette_register_read_index = &HFF and H3C7_palette_register_read_index
end if
return value
end if '->pal
return 0 ' non-palette modes
end if
/'
3dAh (R): Input Status #1 Register
bit 0 Either Vertical or Horizontal Retrace active if set
1 Light Pen has triggered if set
2 Light Pen switch is open if set
3 Vertical Retrace in progress if set
4-5 Shows two of the 6 color outputs, depending on 3C0h index 12h.
Attr: Bit 4-5: Out bit 4 Out bit 5
0 Blue Red
1 I Blue Green
2 I Red I Green
'/
if (port = &H3DA) then
value = 0
if (vertical_retrace_happened or vertical_retrace_in_progress) then
vertical_retrace_happened = 0
value = value or 8
end if
return value
end if
'
' if (port = &H60) then
' ' return last scancode event
' if (port60h_events) then
' value = port60h_event(0)
' if (port60h_events > 1) then
' memmove(port60h_event, port60h_event + 1, 255)
' end if
' port60h_events = prot60h_events - 1
' return value
' else
' return port60h_event(0)
' end if
' end if
'
unsupported_port_accessed = 1
return 0 ' unknown port!
end proc
def SYSTEM_BUS_T.sub_wait(port as integer, andexpression as integer, xorexpression as integer, passed as integer)
if (new_error) then
return
end if
' 1. read value from port
' 2. value^=xorexpression (if passed!)
' 3. value^=andexpression
' IMPORTANT: Wait returns immediately if given port is unsupported by QB64 so program
' can continue
static as integer value
' error & range checking
if ((port > 65535) or (port < -65536)) then
error(6)
return ' Overflow
end if
port = port and &HFFFF
if ((andexpression < -32768) or (andexpression > 65535)) then
error(6)
return ' Overflow
end if
andexpression = andexpression and &HFF
if (passed) then
if ((xorexpression < -32768) or (xorexpression > 65535)) then
error(6)
return ' Overflow
end if
end if
xorexpression = xorexpression and &HFF
wait_loop:
value = func_inp(port)
if (passed) then
value = value xor xorexpression
end if
value = value and andexpression
if (value or unsupported_port_accessed or stop_program) then
return
end if
Sleep(1)
goto wait_loop
end def