Attribute VB_Name = "modSpectrum" ' /******************************************************************************* ' modSpectrum.bas within vbSpec.vbp ' ' Routines for emulating the spectrum hardware; displaying the ' video memory (0x4000 - 0x5AFF), reading the keyboard (port ' 0xFE), and displaying the border colour (out (xxFE),x) ' ' Author: Chris Cowley ' ' Copyright (C)1999-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 Public glNewBorder As Long Function doKey(down As Boolean, ascii As Integer, mods As Integer) As Boolean Dim CAPS As Boolean, SYMB As Boolean, Shift As Boolean CAPS = mods And 1 SYMB = mods And 2 ' // Change control versions of keys to lower case If (ascii >= 1) And (ascii <= &H27&) And SYMB Then ascii = ascii + Asc("a") - 1 End If If CAPS Then keyCAPS_V = (keyCAPS_V And (Not 1&)) Else keyCAPS_V = (keyCAPS_V Or 1&) If SYMB Then keyB_SPC = (keyB_SPC And (Not 2&)) Else keyB_SPC = (keyB_SPC Or 2&) Select Case ascii Case 8 ' Backspace If down Then key6_0 = (key6_0 And (Not 1&)) keyCAPS_V = (keyCAPS_V And (Not 1&)) Else key6_0 = (key6_0 Or 1&) If Not CAPS Then keyCAPS_V = (keyCAPS_V Or 1&) End If End If Case 65 ' A If down Then keyA_G = (keyA_G And (Not 1&)) Else keyA_G = (keyA_G Or 1&) Case 66 ' B If down Then keyB_SPC = (keyB_SPC And (Not 16&)) Else keyB_SPC = (keyB_SPC Or 16&) Case 67 ' C If down Then keyCAPS_V = (keyCAPS_V And (Not 8&)) Else keyCAPS_V = (keyCAPS_V Or 8&) Case 68 ' D If down Then keyA_G = (keyA_G And (Not 4&)) Else keyA_G = (keyA_G Or 4&) Case 69 ' E If down Then keyQ_T = (keyQ_T And (Not 4&)) Else keyQ_T = (keyQ_T Or 4&) Case 70 ' F If down Then keyA_G = (keyA_G And (Not 8&)) Else keyA_G = (keyA_G Or 8&) Case 71 ' G If down Then keyA_G = (keyA_G And (Not 16&)) Else keyA_G = (keyA_G Or 16&) Case 72 ' H If down Then keyH_ENT = (keyH_ENT And (Not 16&)) Else keyH_ENT = (keyH_ENT Or 16&) Case 73 ' I If down Then keyY_P = (keyY_P And (Not 4&)) Else keyY_P = (keyH_ENT Or 4&) Case 74 ' J If down Then keyH_ENT = (keyH_ENT And (Not 8&)) Else keyH_ENT = (keyH_ENT Or 8&) Case 75 ' K If down Then keyH_ENT = (keyH_ENT And (Not 4&)) Else keyH_ENT = (keyH_ENT Or 4&) Case 76 ' L If down Then keyH_ENT = (keyH_ENT And (Not 2&)) Else keyH_ENT = (keyH_ENT Or 2&) Case 77 ' M If down Then keyB_SPC = (keyB_SPC And (Not 4&)) Else keyB_SPC = (keyB_SPC Or 4&) Case 78 ' N If down Then keyB_SPC = (keyB_SPC And (Not 8&)) Else keyB_SPC = (keyB_SPC Or 8&) Case 79 ' O If down Then keyY_P = (keyY_P And (Not 2&)) Else keyY_P = (keyY_P Or 2&) Case 80 ' P If down Then keyY_P = (keyY_P And (Not 1&)) Else keyY_P = (keyY_P Or 1&) Case 81 ' Q If down Then keyQ_T = (keyQ_T And (Not 1&)) Else keyQ_T = (keyQ_T Or 1&) Case 82 ' R If down Then keyQ_T = (keyQ_T And (Not 8&)) Else keyQ_T = (keyQ_T Or 8&) Case 83 ' S If down Then keyA_G = (keyA_G And (Not 2&)) Else keyA_G = (keyA_G Or 2&) Case 84 ' T If down Then keyQ_T = (keyQ_T And (Not 16&)) Else keyQ_T = (keyQ_T Or 16&) Case 85 ' U If down Then keyY_P = (keyY_P And (Not 8&)) Else keyY_P = (keyY_P Or 8&) Case 86 ' V If down Then keyCAPS_V = (keyCAPS_V And (Not 16&)) Else keyCAPS_V = (keyCAPS_V Or 16&) Case 87 ' W If down Then keyQ_T = (keyQ_T And (Not 2&)) Else keyQ_T = (keyQ_T Or 2&) Case 88 ' X If down Then keyCAPS_V = (keyCAPS_V And (Not 4&)) Else keyCAPS_V = (keyCAPS_V Or 4&) Case 89 ' Y If down Then keyY_P = (keyY_P And (Not 16&)) Else keyY_P = (keyY_P Or 16&) Case 90 ' Z If down Then keyCAPS_V = (keyCAPS_V And (Not 2&)) Else keyCAPS_V = (keyCAPS_V Or 2&) Case 48 ' 0 If down Then key6_0 = (key6_0 And (Not 1&)) Else key6_0 = (key6_0 Or 1&) Case 49 ' 1 If down Then key1_5 = (key1_5 And (Not 1&)) Else key1_5 = (key1_5 Or 1&) Case 50 ' 2 If down Then key1_5 = (key1_5 And (Not 2&)) Else key1_5 = (key1_5 Or 2&) Case 51 ' 3 If down Then key1_5 = (key1_5 And (Not 4&)) Else key1_5 = (key1_5 Or 4&) Case 52 ' 4 If down Then key1_5 = (key1_5 And (Not 8&)) Else key1_5 = (key1_5 Or 8&) Case 53 ' 5 If down Then key1_5 = (key1_5 And (Not 16&)) Else key1_5 = (key1_5 Or 16&) Case 54 ' 6 If down Then key6_0 = (key6_0 And (Not 16&)) Else key6_0 = (key6_0 Or 16&) Case 55 ' 7 If down Then key6_0 = (key6_0 And (Not 8&)) Else key6_0 = (key6_0 Or 8&) Case 56 ' 8 If down Then key6_0 = (key6_0 And (Not 4&)) Else key6_0 = (key6_0 Or 4&) Case 57 ' 9 If down Then key6_0 = (key6_0 And (Not 2&)) Else key6_0 = (key6_0 Or 2&) Case 96 ' Keypad 0 If down Then key6_0 = (key6_0 And (Not 1&)) Else key6_0 = (key6_0 Or 1&) Case 97 ' Keypad 1 If down Then key1_5 = (key1_5 And (Not 1&)) Else key1_5 = (key1_5 Or 1&) Case 98 ' Keypad 2 If down Then key1_5 = (key1_5 And (Not 2&)) Else key1_5 = (key1_5 Or 2&) Case 99 ' Keypad 3 If down Then key1_5 = (key1_5 And (Not 4&)) Else key1_5 = (key1_5 Or 4&) Case 100 ' Keypad 4 If down Then key1_5 = (key1_5 And (Not 8&)) Else key1_5 = (key1_5 Or 8&) Case 101 ' Keypad 5 If down Then key1_5 = (key1_5 And (Not 16&)) Else key1_5 = (key1_5 Or 16&) Case 102 ' Keypad 6 If down Then key6_0 = (key6_0 And (Not 16&)) Else key6_0 = (key6_0 Or 16&) Case 103 ' Keypad 7 If down Then key6_0 = (key6_0 And (Not 8&)) Else key6_0 = (key6_0 Or 8&) Case 104 ' Keypad 8 If down Then key6_0 = (key6_0 And (Not 4&)) Else key6_0 = (key6_0 Or 4&) Case 105 ' Keypad 9 If down Then key6_0 = (key6_0 And (Not 2&)) Else key6_0 = (key6_0 Or 2&) Case 106 ' Keypad * If down Then keyB_SPC = (keyB_SPC And Not (18&)) Else If SYMB Then keyB_SPC = (keyB_SPC Or 16&) Else keyB_SPC = (keyB_SPC Or 18&) End If End If Case 107 ' Keypad + If down Then keyH_ENT = (keyH_ENT And (Not 4&)) keyB_SPC = (keyB_SPC And (Not 2&)) Else keyH_ENT = (keyH_ENT Or 4&) If Not SYMB Then keyB_SPC = (keyB_SPC Or 2&) End If End If Case 109 ' Keypad - If down Then keyH_ENT = (keyH_ENT And (Not 8&)) keyB_SPC = (keyB_SPC And (Not 2&)) Else keyH_ENT = (keyH_ENT Or 8&) If Not SYMB Then keyB_SPC = (keyB_SPC Or 2&) End If End If Case 110 ' Keypad . If down Then keyB_SPC = (keyB_SPC And (Not 6&)) Else If SYMB Then keyB_SPC = (keyB_SPC Or 4&) Else keyB_SPC = (keyB_SPC Or 6&) End If End If Case 111 ' Keypad / If down Then keyCAPS_V = (keyCAPS_V And (Not 16&)) keyB_SPC = (keyB_SPC And (Not 2&)) Else keyCAPS_V = (keyCAPS_V Or 16&) If Not SYMB Then keyB_SPC = (keyB_SPC Or 2&) End If End If Case 37 ' Left If down Then key1_5 = (key1_5 And (Not 16&)) keyCAPS_V = (keyCAPS_V And (Not 1&)) Else key1_5 = (key1_5 Or 16&) If Not SYMB Then keyB_SPC = (keyB_SPC Or 2&) End If End If Case 38 ' Up If down Then key6_0 = (key6_0 And (Not 8&)) keyCAPS_V = (keyCAPS_V And (Not 1&)) Else key6_0 = (key6_0 Or 8&) If Not CAPS Then keyCAPS_V = (keyCAPS_V Or 1&) End If End If Case 39 ' Right If down Then key6_0 = (key6_0 And (Not 4&)) keyCAPS_V = (keyCAPS_V And (Not 1&)) Else key6_0 = (key6_0 Or 4&) If Not CAPS Then keyCAPS_V = (keyCAPS_V Or 1&) End If End If Case 40 ' Down If down Then key6_0 = (key6_0 And (Not 16&)) keyCAPS_V = (keyCAPS_V And (Not 1&)) Else key6_0 = (key6_0 Or 16&) If Not CAPS Then keyCAPS_V = (keyCAPS_V Or 1&) End If End If Case 13 ' RETURN If down Then keyH_ENT = (keyH_ENT And (Not 1&)) Else keyH_ENT = (keyH_ENT Or 1&) Case 32 ' SPACE BAR If down Then keyB_SPC = (keyB_SPC And (Not 1&)) Else keyB_SPC = (keyB_SPC Or 1&) Case 187 ' =/+ key If down Then If CAPS Then keyH_ENT = (keyH_ENT And (Not 4&)) Else keyH_ENT = (keyH_ENT And (Not 2&)) End If keyB_SPC = (keyB_SPC And (Not 2&)) keyCAPS_V = (keyCAPS_V Or 1&) Else keyH_ENT = (keyH_ENT Or 4&) keyH_ENT = (keyH_ENT Or 2&) keyB_SPC = (keyB_SPC Or 2&) End If Case 189 ' -/_ key If down Then If CAPS Then key6_0 = (key6_0 And (Not 1&)) Else keyH_ENT = (keyH_ENT And (Not 8&)) End If keyB_SPC = (keyB_SPC And (Not 2&)) keyCAPS_V = (keyCAPS_V Or 1&) Else key6_0 = (key6_0 Or 1&) ' // Release the Spectrum's '0' key keyH_ENT = (keyH_ENT Or 8&) ' // Release the Spectrum's 'J' key keyB_SPC = (keyB_SPC Or 2&) ' // Release the Symbol Shift key End If Case 186 ' ;/: keys If down Then If CAPS Then keyCAPS_V = (keyCAPS_V And (Not 2&)) Else keyY_P = (keyY_P And (Not 2&)) End If keyB_SPC = (keyB_SPC And (Not 2&)) keyCAPS_V = (keyCAPS_V Or 1&) Else keyCAPS_V = (keyCAPS_V Or 2&) keyY_P = (keyY_P Or 2&) keyB_SPC = (keyB_SPC Or 2&) End If Case Else doKey = False End Select doKey = True End Function Public Sub Hook_LDBYTES() Dim l As Long If LoadTAP(glMemAddrDiv256(regAF_), regIX, regDE) Then regAF_ = regAF_ Or 64 ' // Congraturation Load Sucsess! Else regAF_ = regAF_ And 190 ' // Load failed End If l = getAF() setAF regAF_ regAF_ = l regPC = 1506 End Sub Sub plot(addr As Long) Dim lne As Long, i As Long, X As Long If addr < 22528 Then ' // Alter a pixel lne = (glMemAddrDiv256(addr) And &H7&) Or _ (glMemAddrDiv4(addr) And &H38&) Or _ (glMemAddrDiv32(addr) And &HC0&) ScrnLines(lne, 32) = True ScrnLines(lne, addr And 31) = True Else ' // Alter an attribute lne = glMemAddrDiv32(addr - 22528) X = addr Mod 32 For i = lne * 8 To lne * 8 + 7 ScrnLines(i, 32) = True ScrnLines(i, X) = True Next i End If If glUseScreen >= 1000 Then ScrnNeedRepaint = True End Sub Function inb(port As Long) As Long Dim res As Long res = &HFF& If (port And &HFF&) = 254 Then If (port And &H8000&) = 0 Then res = res And keyB_SPC If (port And &H4000&) = 0 Then res = res And keyH_ENT If (port And &H2000&) = 0 Then res = res And keyY_P If (port And &H1000&) = 0 Then res = res And key6_0 If (port And &H800&) = 0 Then res = res And key1_5 If (port And &H400&) = 0 Then res = res And keyQ_T If (port And &H200&) = 0 Then res = res And keyA_G If (port And &H100&) = 0 Then res = res And keyCAPS_V inb = res glTStates = glTStates + glContentionTable(-glTStates) ElseIf port = &HFFFD& Then inb = AYPSG.Regs(glSoundRegister) ElseIf (port And &HFF&) = &HFF& Then If glEmulatedModel = 5 Then ' // TC2048 inb = glTC2048LastFFOut Else If (glTStates >= glTStatesAtTop) And (glTStates <= glTStatesAtBottom) Then inb = 0 Else inb = 255 End If End If ElseIf (port And &HFF&) = 31 Then inb = 0 Else ' // Unconnected port If (glTStates >= glTStatesAtTop) And (glTStates <= glTStatesAtBottom) Then inb = 0 Else inb = 255 End If End If End Function Sub outb(port As Long, outbyte As Long) If (port And &H1&) = 0 Then glLastFEOut = outbyte And &HFF& If glUseScreen <> 1006 Then glNewBorder = glNormalColor(outbyte And &H7&) End If If (outbyte And 16) Then glBeeperVal = 31 Else glBeeperVal = 0 End If glTStates = glTStates + glContentionTable(-glTStates) Exit Sub ElseIf glMemPagingType <> 0 Then ' // 128/+2 memory page operation If port = &H7FFD& Then ' // RAM page glPageAt(3) = (outbyte And 7) ' // Screen page If (outbyte And 8) Then If glUseScreen = 5 Then glUseScreen = 7 initscreen End If Else If glUseScreen = 7 Then glUseScreen = 5 initscreen End If End If ' // ROM If (outbyte And 16) Then glPageAt(0) = 9 glPageAt(4) = 9 Else glPageAt(0) = 8 glPageAt(4) = 8 End If If (outbyte And 32) Then glMemPagingType = 0 glLastOut7FFD = outbyte ElseIf port = &HFFFD& Then glSoundRegister = outbyte And &HF ElseIf port = &HBFFD& Then AYWriteReg glSoundRegister, outbyte ElseIf port = &HBEFD& Then AYWriteReg glSoundRegister, outbyte ' ElseIf port = &H1FFD& Then ' // +2A/+3 special paging mode End If ElseIf glEmulatedModel = 5 Then ' // TC2048=May slow things down :( If port = &HFF& Then glTC2048LastFFOut = outbyte And &HFF& If (outbyte And 7) = 0 Then ' // screen 0 glUseScreen = 5 bmiBuffer.bmiHeader.biWidth = 256 glNewBorder = glNormalColor(glLastFEOut And 7) ElseIf (outbyte And 7) = 1 Then ' // screen 1 glUseScreen = 1001 bmiBuffer.bmiHeader.biWidth = 256 glNewBorder = glNormalColor(glLastFEOut And 7) ElseIf (outbyte And 7) = 2 Then ' // hi-colour glUseScreen = 1002 bmiBuffer.bmiHeader.biWidth = 256 glNewBorder = glNormalColor(glLastFEOut And 7) ElseIf (outbyte And 7) = 6 Then ' // hi-res glUseScreen = 1006 bmiBuffer.bmiHeader.biWidth = 512 If (outbyte And 56) = 0 Then ' // Black on white glTC2048HiResColour = 120 glNewBorder = glBrightColor(7) ElseIf (outbyte And 56) = 8 Then ' // Blue on yellow glTC2048HiResColour = 113 glNewBorder = glBrightColor(6) ElseIf (outbyte And 56) = 16 Then ' // Red on cyan glTC2048HiResColour = 106 glNewBorder = glBrightColor(5) ElseIf (outbyte And 56) = 24 Then ' // Magenta on green glTC2048HiResColour = 99 glNewBorder = glBrightColor(4) ElseIf (outbyte And 56) = 32 Then ' // Green on magenta glTC2048HiResColour = 92 glNewBorder = glBrightColor(3) ElseIf (outbyte And 56) = 40 Then ' // Cyan on red glTC2048HiResColour = 85 glNewBorder = glBrightColor(2) ElseIf (outbyte And 56) = 48 Then ' // Yellow on blue glTC2048HiResColour = 78 glNewBorder = glBrightColor(1) ElseIf (outbyte And 56) = 56 Then ' // White on black glTC2048HiResColour = 71 glNewBorder = glBrightColor(0) End If End If initscreen End If End If End Sub Sub plotTC2048HiResHiArea(addr As Long) Dim lne As Long ' // Alter a pixel in the higher screen (odd columns) lne = (glMemAddrDiv256(addr) And &H7&) Or _ (glMemAddrDiv4(addr) And &H38&) Or _ (glMemAddrDiv32(addr) And &HC0&) ScrnLines(lne, 64) = True ScrnLines(lne, ((addr And 31) * 2) + 1) = True ScrnNeedRepaint = True End Sub Sub plotTC2048HiResLowArea(addr As Long) Dim lne As Long ' // Alter a pixel in the lower screen (even columns) lne = (glMemAddrDiv256(addr) And &H7&) Or _ (glMemAddrDiv4(addr) And &H38&) Or _ (glMemAddrDiv32(addr) And &HC0&) ScrnLines(lne, 64) = True ScrnLines(lne, (addr And 31) * 2) = True ScrnNeedRepaint = True End Sub Public Sub refreshFlashChars() Dim addr As Long, lne As Long, i As Long If glUseScreen > 8 Then TC2048refreshFlashChars Exit Sub End If bFlashInverse = Not (bFlashInverse) For addr = 6144 To 6911 If gRAMPage(glUseScreen, addr) And 128 Then lne = glMemAddrDiv32(addr - 6144) For i = lne * 8 To lne * 8 + 7 ScrnLines(i, 32) = True ScrnLines(i, addr And 31) = True Next i End If Next addr End Sub Public Sub ScanlinePaint(lne As Long) Dim lLneIndex As Long, lColIndex As Long, X As Long, sbyte As Long, abyte As Long, lIndex As Long If glUseScreen >= 1000 Then Exit Sub If ScrnLines(lne, 32) = True Then If lne < glTopMost Then glTopMost = lne If lne > glBottomMost Then glBottomMost = lne lLneIndex = glRowIndex(lne) lColIndex = glColIndex(lne) For X = 0 To 31 If ScrnLines(lne, X) = True Then If X < glLeftMost Then glLeftMost = X If X > glRightMost Then glRightMost = X sbyte = gRAMPage(glUseScreen, glScreenMem(lne, X)) abyte = gRAMPage(glUseScreen, (lLneIndex + X)) If (abyte And 128) And (bFlashInverse) Then ' // Swap fore- and back-colours abyte = abyte Xor 128 End If lIndex = (lColIndex + X + X) glBufferBits(lIndex) = gtBitTable(sbyte, abyte).dw0 glBufferBits(lIndex + 1) = gtBitTable(sbyte, abyte).dw1 End If ScrnLines(lne, X) = False Next X ScrnLines(lne, 32) = False ' // Flag indicates this line has been rendered on the bitmap ScrnNeedRepaint = True End If End Sub Sub screenPaint() ' // Only update screen if necessary If ScrnNeedRepaint = False Then Exit Sub ' // TC2048=May slow things down :( If glUseScreen >= 1000 Then TC2048screenPaint Exit Sub End If glLeftMost = glLeftMost * 8 glRightMost = glRightMost * 8 gpicDisplay.Visible = False StretchDIBits gpicDisplay.hdc, glLeftMost * glDisplayXMultiplier, (glBottomMost + 1) * glDisplayYMultiplier - 1, (glRightMost - glLeftMost + 8) * glDisplayXMultiplier, -(glBottomMost - glTopMost + 1) * glDisplayYMultiplier, glLeftMost, glTopMost, (glRightMost - glLeftMost) + 8, glBottomMost - glTopMost + 1, glBufferBits(0), bmiBuffer, DIB_RGB_COLORS, SRCCOPY gpicDisplay.Visible = True glTopMost = 191 glBottomMost = 0 glLeftMost = 31 glRightMost = 0 ScrnNeedRepaint = False End Sub Sub TC2048PaintHiRes() Dim lne As Long, X As Long Dim sbyte As Long Dim lLeftMost As Long, lRightMost As Long, lTopMost As Long, lBottomMost As Long ' // Bob Woodring's (RGW) improvements to display speed (lookup table of colour values) Dim lIndex As Long Dim lLneIndex As Long Dim lColIndex As Long gpicDisplay.Visible = False lTopMost = 191 lBottomMost = 0 lLeftMost = 63 lRightMost = 0 For lne = 0 To 191 If ScrnLines(lne, 64) = True Then If lne < lTopMost Then lTopMost = lne If lne > lBottomMost Then lBottomMost = lne ' // RGW: Get line and column indexes from a lookup table for speed lLneIndex = glRowIndex(lne) lColIndex = glColIndex(lne) * 2 For X = 0 To 63 If ScrnLines(lne, X) = True Then If X < lLeftMost Then lLeftMost = X If X > lRightMost Then lRightMost = X sbyte = gRAMPage(5, glScreenMemTC2048HiRes(lne, X)) lIndex = (lColIndex + X + X) glBufferBits(lIndex) = gtBitTable(sbyte, glTC2048HiResColour).dw0 glBufferBits(lIndex + 1) = gtBitTable(sbyte, glTC2048HiResColour).dw1 End If ScrnLines(lne, X) = False Next X ScrnLines(lne, 64) = False End If Next lne lLeftMost = lLeftMost * 8 lRightMost = lRightMost * 8 StretchDIBits gpicDisplay.hdc, lLeftMost * (glDisplayXMultiplier / 2), (lBottomMost + 1) * glDisplayYMultiplier - 1, (lRightMost - lLeftMost + 8) * (glDisplayXMultiplier / 2), -(lBottomMost - lTopMost + 1) * glDisplayYMultiplier, lLeftMost, lTopMost, (lRightMost - lLeftMost) + 8, lBottomMost - lTopMost + 1, glBufferBits(0), bmiBuffer, DIB_RGB_COLORS, SRCCOPY gpicDisplay.Visible = True ScrnNeedRepaint = False End Sub Public Sub TC2048refreshFlashChars() Dim addr As Long, lne As Long, i As Long, lScrn As Long, lOffset As Long If glUseScreen = 1006 Then Exit Sub If glUseScreen = 1001 Then lOffset = 8192 ElseIf glUseScreen = 1002 Then ' // HiColour bFlashInverse = Not (bFlashInverse) For addr = 8192 To 14335 If gRAMPage(5, addr) And 128 Then lne = glMemAddrDiv32(addr - 8192) For i = lne * 8 To lne * 8 + 7 ScrnLines(i, 32) = True ScrnLines(i, addr And 31) = True Next i ScrnNeedRepaint = True End If Next addr Exit Sub End If bFlashInverse = Not (bFlashInverse) For addr = 6144 To 6911 If gRAMPage(5, addr + lOffset) And 128 Then lne = glMemAddrDiv32(addr - 6144) For i = lne * 8 To lne * 8 + 7 ScrnLines(i, 32) = True ScrnLines(i, addr And 31) = True Next i ScrnNeedRepaint = True End If Next addr End Sub Sub TC2048screenPaint() If glUseScreen = 1001 Then TC2048ScreenPaintScrn1 ElseIf glUseScreen = 1002 Then TC2048PaintHiColour ElseIf glUseScreen = 1006 Then TC2048PaintHiRes End If End Sub Sub TC2048PaintHiColour() Dim lne As Long, X As Long Dim sbyte As Long, abyte As Long Dim lLeftMost As Long, lRightMost As Long, lTopMost As Long, lBottomMost As Long ' // Bob Woodring's (RGW) improvements to display speed (lookup table of colour values) Dim lIndex As Long Dim lLneIndex As Long Dim lColIndex As Long gpicDisplay.Visible = False lTopMost = 191 lBottomMost = 0 lLeftMost = 31 lRightMost = 0 For lne = 0 To 191 If ScrnLines(lne, 32) = True Then If lne < lTopMost Then lTopMost = lne If lne > lBottomMost Then lBottomMost = lne ' // RGW: Get line and column indexes from a lookup table for speed lLneIndex = glRowIndex(lne) lColIndex = glColIndex(lne) For X = 0 To 31 If ScrnLines(lne, X) = True Then If X < lLeftMost Then lLeftMost = X If X > lRightMost Then lRightMost = X ' // All screen memory is in the bottom 16K of RAM (page 5) sbyte = gRAMPage(5, glScreenMem(lne, X)) abyte = gRAMPage(5, glScreenMem(lne, X) + 8192) If (abyte And 128) And (bFlashInverse) Then ' // Swap fore- and back-colours abyte = abyte Xor 128 End If lIndex = (lColIndex + X + X) glBufferBits(lIndex) = gtBitTable(sbyte, abyte).dw0 glBufferBits(lIndex + 1) = gtBitTable(sbyte, abyte).dw1 End If ScrnLines(lne, X) = False Next X ScrnLines(lne, 32) = False End If Next lne lLeftMost = lLeftMost * 8 lRightMost = lRightMost * 8 StretchDIBits gpicDisplay.hdc, lLeftMost * glDisplayXMultiplier, (lBottomMost + 1) * glDisplayYMultiplier - 1, (lRightMost - lLeftMost + 8) * glDisplayXMultiplier, -(lBottomMost - lTopMost + 1) * glDisplayYMultiplier, lLeftMost, lTopMost, (lRightMost - lLeftMost) + 8, lBottomMost - lTopMost + 1, glBufferBits(0), bmiBuffer, DIB_RGB_COLORS, SRCCOPY gpicDisplay.Visible = True ScrnNeedRepaint = False End Sub Sub TC2048ScreenPaintScrn1() Dim lne As Long, X As Long Dim sbyte As Long, abyte As Long Dim lLeftMost As Long, lRightMost As Long, lTopMost As Long, lBottomMost As Long ' // Bob Woodring's (RGW) improvements to display speed (lookup table of colour values) Dim lIndex As Long Dim lLneIndex As Long Dim lColIndex As Long gpicDisplay.Visible = False lTopMost = 191 lBottomMost = 0 lLeftMost = 31 lRightMost = 0 For lne = 0 To 191 If ScrnLines(lne, 32) = True Then If lne < lTopMost Then lTopMost = lne If lne > lBottomMost Then lBottomMost = lne ' // RGW: Get line and column indexes from a lookup table for speed lLneIndex = glRowIndex(lne) lColIndex = glColIndex(lne) For X = 0 To 31 If ScrnLines(lne, X) = True Then If X < lLeftMost Then lLeftMost = X If X > lRightMost Then lRightMost = X ' // All screen memory is in the bottom 16K of RAM (page 5) sbyte = gRAMPage(5, glScreenMem(lne, X) + 8192) abyte = gRAMPage(5, (lLneIndex + X + 8192)) If (abyte And 128) And (bFlashInverse) Then ' // Swap fore- and back-colours abyte = abyte Xor 128 End If lIndex = (lColIndex + X + X) glBufferBits(lIndex) = gtBitTable(sbyte, abyte).dw0 glBufferBits(lIndex + 1) = gtBitTable(sbyte, abyte).dw1 End If ScrnLines(lne, X) = False Next X ScrnLines(lne, 32) = False End If Next lne lLeftMost = lLeftMost * 8 lRightMost = lRightMost * 8 StretchDIBits gpicDisplay.hdc, lLeftMost * glDisplayXMultiplier, (lBottomMost + 1) * glDisplayYMultiplier - 1, (lRightMost - lLeftMost + 8) * glDisplayXMultiplier, -(lBottomMost - lTopMost + 1) * glDisplayYMultiplier, lLeftMost, lTopMost, (lRightMost - lLeftMost) + 8, lBottomMost - lTopMost + 1, glBufferBits(0), bmiBuffer, DIB_RGB_COLORS, SRCCOPY gpicDisplay.Visible = True ScrnNeedRepaint = False End Sub