Attribute VB_Name = "modTAP"
' /*******************************************************************************
'   modTAP.bas within vbSpec.vbp
'
'   Handles loading of ".TAP" files (Spectrum tape images)
'
'   Author: Chris Cowley <ccowley@grok.co.uk>
'
'   Copyright (C)2001-2002 Grok Developments Ltd.
'   http://www.grok.co.uk/
'
'   This program is free software; you can redistribute it and/or
'   modify it under the terms of the GNU General Public License
'   as published by the Free Software Foundation; either version 2
'   of the License, or (at your option) any later version.
'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'   GNU General Public License for more details.
'
'   You should have received a copy of the GNU General Public License
'   along with this program; if not, write to the Free Software
'   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
'
' *******************************************************************************/

Option Explicit

Private m_lChecksum As Long

Public Sub CloseTAPFile()
    If ghTAPFile > 0 Then
        Close ghTAPFile
        ghTAPFile = 0
    End If
End Sub

Public Function LoadTAP(lID As Long, lStart As Long, lLength As Long) As Boolean
    Dim lBlockLen As Long, s As String, lBlockID As Long, lBlockChecksum As Long
    
    On Error Resume Next
    
    If gsTAPFileName = "" Then
        LoadTAP = False
    Else
        If Seek(ghTAPFile) > LOF(ghTAPFile) Then Seek #ghTAPFile, 1
        If EOF(ghTAPFile) Then Seek #ghTAPFile, 1
        s = Input(2, #ghTAPFile)
        lBlockLen = Asc(Right$(s, 1)) * 256& + Asc(Left$(s, 1)) - 2
        
        lBlockID = Asc(Input(1, #ghTAPFile))
        m_lChecksum = lBlockID ' // Initialize the checksum
        
        If lBlockID = lID Then
            ' // This block type is the same as the requested block type
            If lLength <= lBlockLen Then
                ' // There are enough bytes in the block to cover this request
                ReadTAPBlock lStart, lLength
                If lLength < lBlockLen Then
                    ' // Skip the rest of the bytes up to the end of the block
                    SkipTAPBytes lBlockLen - lLength
                End If
                lBlockChecksum = Asc(Input(1, #ghTAPFile))
                regIX = (regIX + lLength) And &HFFFF&
                regDE = 0
                If m_lChecksum = lBlockChecksum Then
                    LoadTAP = True
                Else
                    LoadTAP = False
                End If
            Else
                ' // More bytes requested than there are in the block
                ReadTAPBlock lStart, lBlockLen
                lBlockChecksum = Asc(Input(1, #ghTAPFile))
                regIX = (regIX + lBlockLen) And &HFFFF&
                regDE = regDE - lBlockLen
                LoadTAP = False
            End If
        Else
            ' // Wrong block type -- skip this block
            SkipTAPBytes lBlockLen
            lBlockChecksum = Asc(Input(1, #ghTAPFile))
            LoadTAP = False
        End If
    End If
    initscreen
    screenPaint
    
    If gbSoundEnabled Then
        waveOutReset glphWaveOut
        For glBufNum = 1 To 12
            waveOutWrite glphWaveOut, gtWavHdr(glBufNum), Len(gtWavHdr(glBufNum))
        Next glBufNum
        glBufNum = 12
    End If
End Function
Public Sub OpenTAPFile(sName As String)
    If Dir$(sName) = "" Then Exit Sub
    If ghTAPFile > 0 Then Close #ghTAPFile
    
    If Dir$(sName) = "" Then Exit Sub
    
    ghTAPFile = FreeFile
    Open sName For Binary As ghTAPFile
    
    If LOF(ghTAPFile) = 0 Then
        Close #ghTAPFile
        Exit Sub
    End If
    
    gsTAPFileName = sName
    
    frmMainWnd.Caption = App.ProductName & " - " & GetFilePart(sName)
End Sub
Private Sub ReadTAPBlock(lStart As Long, lLen As Long)
    Dim s As String, b As Long, lCounter As Long
    
    On Error Resume Next
    
    s = Input(lLen, #ghTAPFile)
    For lCounter = 1 To Len(s)
        b = Asc(Mid$(s, lCounter, 1))
        pokeb lStart + lCounter - 1, b
        m_lChecksum = m_lChecksum Xor b
    Next lCounter
End Sub

Private Sub SkipTAPBytes(lLen As Long)
    Dim s As String, lCounter As Long
    
    s = Input(lLen, #ghTAPFile)
    For lCounter = 1 To Len(s)
        m_lChecksum = m_lChecksum Xor Asc(Mid$(s, lCounter, 1))
    Next lCounter
End Sub