; Copyright 1996 Acorn Computers Ltd
;
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
;
;     http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
; See the License for the specific language governing permissions and
; limitations under the License.
;
; > $.Source.VduWrch

;       Text printing etc.
;       ------------------

;       Author          Tim Dobson
;       Started         01-Sep-86
;       Status          Mostly Arm-less

; *****************************************************************************

; CursorFlags bits

; Bit   0       '81 column' mode
; Bits  1-3     Cursor movement directions
; Bit   4       Wrap instead of scroll in VDU4 mode
; Bit   5       Don't move cursor after printing character
; Bit   6       Don't wrap in VDU 5 mode
; Bit   7       Unused but could be set by user
; Bit   8       When in Wrch or screen update operation, set to 1 and forms
;               part of mask for ROR #10.
;               Otherwise is set to 0.
;               Tested by cursor code to see if it can update CursorFlags.
; Bits  9-17    Set to 101111000 so we can TST CursorFlags with itself ROR #10
;               to test for OR of C81Bit, Vdu5Bit, silly movement bits in 1 go
;               in order to optimise the case when none of these are present
; Bit   18      Set when cursors are split - since bit 8 is set this triggers
; Bit   19      Set when in teletext mode
; Bit   20      Set when in page mode
; Bit   21      Set when clip box calculations are enabled - this triggers
; Bits  22-24   Unused, but probably have to be zero because of ROR #10
; Bit   25      Actual cursor state  (1 => cursor is on screen)
; Bit   26      Set if VDU disabled
; Bits  27-28   Unused, but probably have to be zero because of ROR #10
; Bit   29      TextExpand not up-to-date
; Bit   30      VDU 5 mode
; Bit   31      In the '81st' column

InWrchBitPosn * 8
InWrchBit        *  1 :SHL: InWrchBitPosn
CursorsSplit     *  1 :SHL: 18
TeletextMode     *  1 :SHL: 19
PageMode         *  1 :SHL: 20
ClipBoxEnableBit *  1 :SHL: 21
ActualState      *  1 :SHL: 25
VduDisabled      *  1 :SHL: 26
TEUpdate         *  1 :SHL: 29
Vdu5Bit          *  1 :SHL: 30
C81Bit           *  1 :SHL: 31
InitialCursorFlags * (&1E :SHL: 10) :OR: (C81Bit :SHR: (32-10))

; The TST R6, R6, ROR #10 returns non-zero if
;
;       C81Bit OR Vdu5 OR (any of bits 1-4) OR CursorsSplit
;       OR ClipBoxEnableBit OR (TEUpdate AND bit7) OR Teletext
;
; The last two of these are slightly undesirable, but fairly harmless since:
;   (a) bit 7 is not normally set, and TEUpdate is only set when a colour
;       change happens.
;   (b) Teletext mode takes quite a long time anyway.
; NB We don't believe that the TST needs to detect Teletext mode, but if you
; want to stop it doing so, it's on your own head. Check everything carefully!

; *****************************************************************************
;
;       Set default logical and physical colours

bpp     RN      0
fore    RN      1
back    RN      2
tabaddr RN      3
index   RN      4
source  RN      5
dest    RN      6
col     RN      7
orrbits RN      8
addbits RN      9
bit0    RN      10

hiaddr  RN      4
loaddr  RN      5
; dest          6
hiword  RN      7       ; must be higher number than dest (for Colour16Bit)
loword  RN      8
cbyte   RN      9
spare1  RN      10
spare2  RN      11

; *****************************************************************************
;
;       VDU 20 - Set default colours (if output mode not teletext)
;        and palette (if display mode not teletext)
;
;       External routine, and DefaultColours called by mode change
;        and SwitchOutputToSprite
;
; in:   R6 = CursorFlags (for output mode)
;

VDU20   ROUT
        LDR     R0, [WsPtr, #DisplayModeFlags]  ; if display mode is
        TST     R0, #ModeFlag_Teletext          ; not teletext, then restore
        BNE     %FT10                           ; default palette

        Push    R14
        BL      PalInit                         ; R6 is preserved over the call
        Pull    R14
10
        TST     R6, #TeletextMode               ; if output mode is teletext
        MOVNE   PC, R14                         ; then don't reset colours

; else drop thru to ...

DefaultColours ROUT
        Push    R14

        ASSERT  GPLBMD = GPLFMD +4
        ASSERT  GFCOL = GPLFMD +8
        ASSERT  GBCOL = GPLFMD +12

        ASSERT  TBTint = TFTint +4
        ASSERT  GFTint = TFTint +8
        ASSERT  GBTint = TFTint +12

        ASSERT  TBackCol = TForeCol +4
        ASSERT  back > fore

        MOV     R0, #0                  ; foreground action := store
        MOV     R1, #0                  ; background action := store
        LDR     R2, [WsPtr, #NColour]   ; GCOL(0,(NColour AND 7)) except
        TST     R2, #&F0                ; for 256 colour modes
        ANDEQ   R2, R2, #7              ; when we use colour 63 (=NColour)
        MOV     R3, #0                  ; background colour := black
        ADD     R4, WsPtr, #GPLFMD      ; store GPLFMD, GPLBMD, GFCOL, GBCOL
        STMIA   R4, {R0-R3}

        MOV     R0, #&FF                ; R0 = TFTint := &FF; R1 = TBTint := 0
        MOV     R2, #&FF                ; R2 = GFTint := &FF; R3 = GBTint := 0
        ADD     R4, WsPtr, #TFTint
        STMIA   R4, {R0-R3}

        BL      SetColour               ; Update FgEcf & BgEcf

        LDR     bpp, [WsPtr, #BitsPerPix]
        LDR     fore, [WsPtr, #NColour] ; Number of colours allowed -1
        LDR     R8, [WsPtr, #ModeFlags]
        TEQ     fore, #63               ; are we in bodgy 256 colour mode?
        MOVEQ   fore, #255              ; then use colour 255 (cringe!)
        TEQ     fore, #15               ; 16 colour mode
        TSTEQ   R8, #ModeFlag_GreyscalePalette
        MOVEQ   fore, #7                ; Default is 7 for this depth of mode
        CMP     fore, #255
        MOV     back, #0
        BLS     %FT10
        ; Deal with true colour modes
        ; Default foreground is white, background is black
        ; Alpha/supremacy is taken from mode flags
        BL      GetAlphaSupremacyBits_AltEntry
        ; Arrive here with fore = full RGB, back = alpha/supremacy mask
        TST     R8, #ModeFlag_DataFormatSub_Alpha
        ORRNE   fore, fore, back        ; Is alpha blended mode, so set full alpha
        MOVEQ   back, #0                ; Transparency/supremacy mode, clear transfer channel


10
        ADD     R14, WsPtr, #TForeCol
        STMIA   R14, {fore, back}               ; save fgd + bgd text colours
        Pull    R14

;       and drop thru to ...

SetColours ROUT
        Push    R14

        CMP     bpp, #16

        MOVLS   R8, back, ROR bpp               ; move bits to top of word
        MOVLS   R9, fore, ROR bpp

        LDR     bpp, [WsPtr, #BytesPerChar]     ; fudge some more bits

        BHI     %FT20                           ; can't fudge anything over 16bpp
        ORR     back, R8, back, ROR bpp
        ORR     fore, R9, fore, ROR bpp

        MOV     LR, bpp
10
        TEQ     LR, #32                         ; have we finished replicating through word yet?
        ORRNE   back, back, back, LSR LR        ;   if not then expand again through the word
        ORRNE   fore, fore, fore, LSR LR
        MOVNE   LR, LR, LSL #1                  ; double the shift ready for the next pass
        BNE     %BT10                           ;   and loop again!

20
        STR     fore, [WsPtr, #TextFgColour]
        STR     back, [WsPtr, #TextBgColour]    ; store bit expanded fore / background colour

;       New colour change code
;       entered with fore, back expanded to <bytes_per_char> bits
;       and bpp set to be <bytes_per_char>

        TEQ     bpp, #16
        BEQ     Colour16Bit     ; can't optimise

        TEQ     bpp, #32
        BEQ     Colour32Bit     ; cannie optimise captin!

        EOR     fore, fore, back                ; so we can AND and EOR
        LDR     loaddr, [WsPtr, #TextExpandArea]
        ADD     dest, loaddr, bpp, LSL #8       ; end+1 destination addr
        MOV     hiaddr, dest                    ; TextPlain now moves around,
                                                ; depending on bytes-per-char
30
        LDR     cbyte, [hiaddr], #4
        AND     cbyte, cbyte, fore
        EOR     cbyte, cbyte, back
        STR     cbyte, [loaddr], #4
        TEQ     loaddr, dest
        BNE     %BT30

        Pull    PC
        LTORG

; *****************************************************************************
;
;       GetAlphaSupremacyBits - Get bit masks that correspond to the RGB and
;       alpha/supremacy components of a true-colour pixel
;
;       Exits with:
;       fore = RGB mask
;       back = alpha/supremacy mask
;       R8 = mode flags
;       R9 corrupt
;

GetAlphaSupremacyBits ROUT
        LDR     fore, [WsPtr, #NColour] ; Number of colours allowed -1
        LDR     R8, [WsPtr, #ModeFlags]
GetAlphaSupremacyBits_AltEntry
        MOV     R9, fore
        MOV     fore, #-1
        CMP     R9, #-1                 ; 32bpp?
        BIC     fore, fore, #&FF000000
        MOVEQ   back, #&FF000000        ; top byte is alpha/supremacy
        TEQNE   R9, fore                ; 24bpp packed?
        MOVEQ   pc, lr
        BIC     fore, fore, #&FF0000
        TEQ     R9, fore, LSR #4        ; 4k?
        MOVEQ   fore, fore, LSR #4
        MOVEQ   back, #&F000
        MOVEQ   pc, lr
        ; Not 32bpp, 24bpp or 4k, so must be 32k or 64k
        TST     R8, #ModeFlag_64k
        BICEQ   fore, fore, #&8000      ; is 32k
        MOVEQ   back, #&8000
        MOV     pc, lr

; *****************************************************************************
;
;       Colour16Bit - Set up colour table for 16 bits per pixel
;       Entered with R14 already pushed
;

Colour16Bit
        LDR     tabaddr, [WsPtr, #TextExpandArea]


        ADR     hiaddr, C16BTab
        ADD     R10, hiaddr, #128
C16B20
        ADR     loaddr, C16BTab
C16B30
        LDMIA   hiaddr, {dest, hiword}
        BL      OutputColour
        MOV     dest, hiword
        BL      OutputColour

        LDMIA   loaddr!, {dest, loword}
        BL      OutputColour
        MOV     dest, loword
        BL      OutputColour

        TEQ     loaddr, R10
        BNE     C16B30

        ADD     hiaddr, hiaddr, #8
        TEQ     hiaddr, R10
        BNE     C16B20

        Pull    PC

C16BTab
        &       &00000000, &00000000
        &       &00000000, &FFFF0000
        &       &00000000, &0000FFFF
        &       &00000000, &FFFFFFFF

        &       &FFFF0000, &00000000
        &       &FFFF0000, &FFFF0000
        &       &FFFF0000, &0000FFFF
        &       &FFFF0000, &FFFFFFFF

        &       &0000FFFF, &00000000
        &       &0000FFFF, &FFFF0000
        &       &0000FFFF, &0000FFFF
        &       &0000FFFF, &FFFFFFFF

        &       &FFFFFFFF, &00000000
        &       &FFFFFFFF, &FFFF0000
        &       &FFFFFFFF, &0000FFFF
        &       &FFFFFFFF, &FFFFFFFF

; *****************************************************************************
;
;       Colour32Bit - Set up colour table for 32 bits per pixel
;       Entered with R14 already pushed
;

Colour32Bit
        LDR     tabaddr, [WsPtr, #TextExpandArea]
        MOV     dest, #0
C32B20

; Expand the value in 'dest' so that each bit is stored as a word
; zero bits are stored in the background and non-zero bits are stored in
; foreground.  This is indexed when expanding the 1BPP VDU font out to
; the current depth.

        TST     dest, #1 <<7
        STREQ   back, [tabaddr], #4
        STRNE   fore, [tabaddr], #4
        TST     dest, #1 <<6
        STREQ   back, [tabaddr], #4
        STRNE   fore, [tabaddr], #4
        TST     dest, #1 <<5
        STREQ   back, [tabaddr], #4
        STRNE   fore, [tabaddr], #4
        TST     dest, #1 <<4
        STREQ   back, [tabaddr], #4
        STRNE   fore, [tabaddr], #4
        TST     dest, #1 <<3
        STREQ   back, [tabaddr], #4
        STRNE   fore, [tabaddr], #4
        TST     dest, #1 <<2
        STREQ   back, [tabaddr], #4
        STRNE   fore, [tabaddr], #4
        TST     dest, #1 <<1
        STREQ   back, [tabaddr], #4
        STRNE   fore, [tabaddr], #4
        TST     dest, #1 <<0
        STREQ   back, [tabaddr], #4
        STRNE   fore, [tabaddr], #4

        ADD     dest, dest, #1
        TEQ     dest, #256
        BNE     C32B20

        Pull    "PC"

; *****************************************************************************
;
;       Fast CLS used when no text window defined
;

FastCLS ROUT
        Push    R14
        BL      CheckTEUpdate

        TST     R6, #TeletextMode               ; teletext mode ?
        BEQ     %FT10                           ; and skip

        BL      TTXFastCLS                      ; else clear teletext map
        MOV     R5, #7
        MOV     R6, #8                          ; and clear screen to (transparent) black
        BL      TTXUpdateColours
        B       %FT15
10
        BL      CheckAcceleration
        BNE     %FT15
        MOV     R11, R13                        ; try to do an accelerated
        BIC     R13, R13, #63                   ; rectangle fill - need an
        LDR     R0, [WsPtr, #TextBgColour]
        MOV     R1, #&FFFFFFFF                  ; alignedOraEor block
        MVN     R2, R0
        MOV     R3, R1
        MOV     R4, R2
        Push    "R1-R4"
        Push    "R1-R4"
        Push    "R1-R4"
        Push    "R1-R4"
        MOV     R0, #0                          ; left
        LDR     R1, [WsPtr, #YWindLimit]        ; top
        LDR     R2, [WsPtr, #XWindLimit]        ; right (okay because checked BPC=BPP)
        MOV     R3, #0                          ; bottom
        MOV     R4, R13                         ; colour block
        Push    "R0-R4"
        MOV     R0, #GVRender_Sync
        MOV     R1, #GVRender_FillRectangle
        MOV     R2, R13
        LDR     R4, [WsPtr, #CurrentGraphicsVDriver]
        MOV     R4, R4, LSL #24
        ORR     R4, R4, #GraphicsV_Render
        BL      CallGraphicsV
        MOV     R13, R11
        TEQ     R4, #GraphicsV_Complete
        Pull    PC, EQ
15
        ; If the framebuffer rows aren't contiguous then we must use SlowCLS
        LDR     R0, [WsPtr, #XWindLimit]
        LDR     R1, [WsPtr, #Log2BPP]
        ADD     R0, R0, #1
        LDR     R2, [WsPtr, #LineLength]
        MOV     R0, R0, LSL R1
        CMP     R0, R2, LSL #3
        Pull    "LR", NE
        BNE     SlowCLS

        LDR     R0, [WsPtr, #TextBgColour]
        LDR     R8, [WsPtr, #ScreenStart]
        MOV     R1, R0
        MOV     R2, R0
        MOV     R3, R0
        MOV     R4, R0
        MOV     R5, R0
        MOV     R6, R0
        MOV     R7, R0
        LDR     R9, [WsPtr, #ScreenSize]        ; screen size in bytes
20
        SUBS    R9, R9, #256                    ; if another 256 to do
        STMCSIA R8!, {R0 - R7}                  ; a bit excessive, I know !
        STMCSIA R8!, {R0 - R7}
        STMCSIA R8!, {R0 - R7}
        STMCSIA R8!, {R0 - R7}
        STMCSIA R8!, {R0 - R7}
        STMCSIA R8!, {R0 - R7}
        STMCSIA R8!, {R0 - R7}
        STMCSIA R8!, {R0 - R7}
        BHI     %BT20                           ; only loop if more to do
        ADDCC   R9, R9, #256                    ; add back the last 256
30
        SUBS    R9, R9, #4
        STRCS   R0, [R8], #4
        BHI     %BT30

        Pull    PC

; *****************************************************************************
;
;       Home cursor to "top left"

RS
Home
        MOV     R0, #0
        MOV     R1, #0
        B       TabR0R1

; *****************************************************************************
;
;       Address text cursor position
; in:   R0 = X position
;       R1 = Y position
;
; out:  CursorAddr contains screen address

CursorR0R1
        STR     R0, [WsPtr, #CursorX]
        STR     R1, [WsPtr, #CursorY]
CTADDR10
        Push    R14
        BL      AddressR0R1
        STR     R2, [WsPtr, #CursorAddr]
        Pull    PC

;       Calculate cursor address

AddressCursor
        LDR     R0, [WsPtr, #CursorX]
        LDR     R1, [WsPtr, #CursorY]
        B       CTADDR10


;       Address an X,Y text position in R0,R1
;       R2 is screen address on exit
;       R1, R3, R4 corrupted; R0, R5-R13 preserved

AddressR0R1     ROUT
        LDR     R2, [WsPtr, #ScreenStart] ; start address of top of screen
        LDR     R4, [WsPtr, #TextOffset]  ; offset for centering text window
        LDR     R3, [WsPtr, #CharWidth]
        ADD     R2, R2, R4
        LDR     R4, [WsPtr, #RowLength]
        MLA     R2, R3, R0, R2            ; add in X offset
        MLA     R2, R4, R1, R2            ; add in Y*RowLength
        MOV     PC, R14

; *****************************************************************************
;
;       Write character in R0 (>=32) to the screen
;       R6 = CursorFlags on entry
;

font    RN      1
screen  RN      2
bigfont RN      3
mask    RN      4
tophalf RN      5
bottomhalf RN   6
lbpp    RN      7
byte    RN      8
scrbyte RN      9
scrbyte2 RN     10
linelen RN      11

; *****Comment by DJS: Given we want applications to use the windowing world,
;   shouldn't we be optimising VDU 5 characters a bit more here? - even if it
;   makes VDU 4 characters a bit less optimal?

TimWrch ROUT
        LDR     R1, [WsPtr, #VduStatus]         ; test all silly flags at once
        TST     R1, #Vdu2Mode
        TSTEQ   R6, #(VduDisabled :OR: TEUpdate :OR: C81Bit :OR: Vdu5Bit)
        TSTEQ   R6, #(TeletextMode :OR: ClipBoxEnableBit)
10
        ADDEQ   font, WsPtr, #(Font-32*8)
        ADDEQ   font, font, R0, LSL #3
        LDMEQIA font, {tophalf, bottomhalf}
        Push    R14, EQ
        ADREQ   R14, %FT15
        LDREQ   screen, [WsPtr, #CursorAddr]
        LDREQ   bigfont, [WsPtr, #TextExpandArea]
        LDREQ   linelen, [WsPtr, #LineLength]
        LDREQ   PC, [WsPtr, #WrchNbit]

; *****Change made by DJS
; Moved the following code down to a place where we don't have to branch
; around it!
;        B       %FT20
;15
;        Pull    R14
;PostCharMove
;        LDR     R6, [WsPtr, #CursorFlags]
;        TST     R6, #32                         ; move cursor after char ?
;        BEQ     CHT                             ; move "right" & test for C81
;        MOV     PC, R14
;
;20
; *****End of change made by DJS

; if printing enabled then we want to print this character,
; so pull the old R14 off the stack

        TST     R1, #Vdu2Mode
        Pull    R14, NE                         ; in VDU 2 mode, so pull R14
        TST     R6, #VduDisabled                ; if VDU disabled
        MOVNE   PC, R14                         ; then don't print it
        TST     R6, #TEUpdate                   ; if colours need updating
        BNE     %FT30                           ; then do it + return to %25
25
        TST     R6, #Vdu5Bit
        BNE     Vdu5Wrch
        TST     R6, #C81Bit
        BNE     %FT40
35
        TST     R6, #TeletextMode
        BNE     TTXWrch
        TST     R6, #ClipBoxEnableBit
        BEQ     %BT10                           ; must enter with EQ

; now update clip box

        Push    R14
        BL      ClipCursorCell
        Pull    R14
        TST     R0, #0                          ; set EQ
        B       %BT10

; *****Change made by DJS
; Code moved down from above.

15
        Pull    R14
PostCharMove
        LDR     R6, [WsPtr, #CursorFlags]
        TST     R6, #32                         ; move cursor after char ?
        BEQ     CHT                             ; move "right" & test for C81
        MOV     PC, R14

; *****End of change made by DJS

30
        Push    "R0,R14"
        BL      ReallySetColours                ; update colour table
        Pull    "R0,R14"
        B       %BT25

40
        Push    "R0, R14"
        BL      RCRLFR6                         ; do pending CRLF
        Pull    "R0, R14"
        B       %BT35

; *****************************************************************************
;
;       Write character in 1 bit-per-pixel mode

Wrch1bit

; *****Change made by DJS
; Original code was:
;        MOV     mask, #&FF000000
;
;        AND     byte, mask, tophalf, LSL #24
;        LDRB    scrbyte, [bigfont, byte, LSR #24]
;        STRB    scrbyte, [screen], linelen
;        AND     byte, mask, tophalf, LSL #16
;        LDRB    scrbyte, [bigfont, byte, LSR #24]
;        STRB    scrbyte, [screen], linelen
;        AND     byte, mask, tophalf, LSL #8
;        LDRB    scrbyte, [bigfont, byte, LSR #24]
;        STRB    scrbyte, [screen], linelen
;        LDRB    scrbyte, [bigfont, tophalf, LSR #24]
;        STRB    scrbyte, [screen], linelen
;
;        AND     byte, mask, bottomhalf, LSL #24
;        LDRB    scrbyte, [bigfont, byte, LSR #24]
;        STRB    scrbyte, [screen], linelen
;        AND     byte, mask, bottomhalf, LSL #16
;        LDRB    scrbyte, [bigfont, byte, LSR #24]
;        STRB    scrbyte, [screen], linelen
;        AND     byte, mask, bottomhalf, LSL #8
;        LDRB    scrbyte, [bigfont, byte, LSR #24]
;        STRB    scrbyte, [screen], linelen
;        LDRB    scrbyte, [bigfont, bottomhalf, LSR #24]
;        STRB    scrbyte, [screen], linelen
;
; There is no need to use "mask" at all in this...

        MOV     byte, tophalf, LSL #24
        LDRB    scrbyte, [bigfont, byte, LSR #24]
        STRB    scrbyte, [screen], linelen
        MOV     byte, tophalf, LSL #16
        LDRB    scrbyte, [bigfont, byte, LSR #24]
        STRB    scrbyte, [screen], linelen
        MOV     byte, tophalf, LSL #8
        LDRB    scrbyte, [bigfont, byte, LSR #24]
        STRB    scrbyte, [screen], linelen
        LDRB    scrbyte, [bigfont, tophalf, LSR #24]
        STRB    scrbyte, [screen], linelen

        MOV     byte, bottomhalf, LSL #24
        LDRB    scrbyte, [bigfont, byte, LSR #24]
        STRB    scrbyte, [screen], linelen
        MOV     byte, bottomhalf, LSL #16
        LDRB    scrbyte, [bigfont, byte, LSR #24]
        STRB    scrbyte, [screen], linelen
        MOV     byte, bottomhalf, LSL #8
        LDRB    scrbyte, [bigfont, byte, LSR #24]
        STRB    scrbyte, [screen], linelen
        LDRB    scrbyte, [bigfont, bottomhalf, LSR #24]
        STRB    scrbyte, [screen], linelen

; *****End of change made by DJS

        [ 1=0 ; *** No 1 bpc non-BBC gap modes at present ***
        LDR     R0, [WsPtr, #ModeFlags]         ; now test for non-BBC gap mode
        AND     R0, R0, #(ModeFlag_GapMode :OR: ModeFlag_BBCGapMode) ; we want R0=0 iff
        EORS    R0, R0, #ModeFlag_GapMode       ; (gapmode AND NOT bbcgapmode)
        MOVNE   PC, R14
        LDRB    scrbyte, [bigfont]              ; store backgd in next 2
        STRB    scrbyte, [screen], linelen
        STRB    scrbyte, [screen], linelen
        ]
        MOV     PC, R14

Wrch1bitDouble

; *****Change made by DJS
; Original code was:
;        MOV     mask, #&FF000000
;
;        AND     byte, mask, tophalf, LSL #24
;        LDRB    scrbyte, [bigfont, byte, LSR #24]
;        STRB    scrbyte, [screen], linelen
;        STRB    scrbyte, [screen], linelen
;        AND     byte, mask, tophalf, LSL #16
;        LDRB    scrbyte, [bigfont, byte, LSR #24]
;        STRB    scrbyte, [screen], linelen
;        STRB    scrbyte, [screen], linelen
;        AND     byte, mask, tophalf, LSL #8
;        LDRB    scrbyte, [bigfont, byte, LSR #24]
;        STRB    scrbyte, [screen], linelen
;        STRB    scrbyte, [screen], linelen
;        LDRB    scrbyte, [bigfont, tophalf, LSR #24]
;        STRB    scrbyte, [screen], linelen
;        STRB    scrbyte, [screen], linelen
;
;        AND     byte, mask, bottomhalf, LSL #24
;        LDRB    scrbyte, [bigfont, byte, LSR #24]
;        STRB    scrbyte, [screen], linelen
;        STRB    scrbyte, [screen], linelen
;        AND     byte, mask, bottomhalf, LSL #16
;        LDRB    scrbyte, [bigfont, byte, LSR #24]
;        STRB    scrbyte, [screen], linelen
;        STRB    scrbyte, [screen], linelen
;        AND     byte, mask, bottomhalf, LSL #8
;        LDRB    scrbyte, [bigfont, byte, LSR #24]
;        STRB    scrbyte, [screen], linelen
;        STRB    scrbyte, [screen], linelen
;        LDRB    scrbyte, [bigfont, bottomhalf, LSR #24]
;        STRB    scrbyte, [screen], linelen
;        STRB    scrbyte, [screen], linelen
;
; As above, "mask" is not needed.

        MOV     byte, tophalf, LSL #24
        LDRB    scrbyte, [bigfont, byte, LSR #24]
        STRB    scrbyte, [screen], linelen
        STRB    scrbyte, [screen], linelen
        MOV     byte, tophalf, LSL #16
        LDRB    scrbyte, [bigfont, byte, LSR #24]
        STRB    scrbyte, [screen], linelen
        STRB    scrbyte, [screen], linelen
        MOV     byte, tophalf, LSL #8
        LDRB    scrbyte, [bigfont, byte, LSR #24]
        STRB    scrbyte, [screen], linelen
        STRB    scrbyte, [screen], linelen
        LDRB    scrbyte, [bigfont, tophalf, LSR #24]
        STRB    scrbyte, [screen], linelen
        STRB    scrbyte, [screen], linelen

        MOV     byte, bottomhalf, LSL #24
        LDRB    scrbyte, [bigfont, byte, LSR #24]
        STRB    scrbyte, [screen], linelen
        STRB    scrbyte, [screen], linelen
        MOV     byte, bottomhalf, LSL #16
        LDRB    scrbyte, [bigfont, byte, LSR #24]
        STRB    scrbyte, [screen], linelen
        STRB    scrbyte, [screen], linelen
        MOV     byte, bottomhalf, LSL #8
        LDRB    scrbyte, [bigfont, byte, LSR #24]
        STRB    scrbyte, [screen], linelen
        STRB    scrbyte, [screen], linelen
        LDRB    scrbyte, [bigfont, bottomhalf, LSR #24]
        STRB    scrbyte, [screen], linelen
        STRB    scrbyte, [screen], linelen

; *****End of change made by DJS

        [ 1=0 ; *** No 1 bpc non-BBC gap modes at present ***
        LDR     R0, [WsPtr, #ModeFlags]         ; now test for non-BBC gap mode
        AND     R0, R0, #(ModeFlag_GapMode :OR: ModeFlag_BBCGapMode) ; we want R0=0 iff
        EORS    R0, R0, #ModeFlag_GapMode       ; (gapmode AND NOT bbcgapmode)
        MOVNE   PC, R14
        LDRB    scrbyte, [bigfont]              ; store backgd in next 2
        STRB    scrbyte, [screen], linelen
        STRB    scrbyte, [screen], linelen
        ]
        MOV     PC, R14

Wrch2bit

; *****Change made by DJS
; Original code was:
;
;        MOV     mask, #&FE000000
;        SUB     linelen, linelen, #1
;
;        AND     byte, mask, tophalf, LSL #24
;        LDR     scrbyte, [bigfont, byte, LSR #23]
;        MOVS    byte, tophalf, LSR #1
;        MOVCS   scrbyte, scrbyte, LSR #16
;        STRB    scrbyte, [screen], #1
;        MOV     scrbyte, scrbyte, LSR #8
;        STRB    scrbyte, [screen], linelen
;
;        AND     byte, mask, tophalf, LSL #16
;        LDR     scrbyte, [bigfont, byte, LSR #23]
;        MOVS    byte, tophalf, LSR #9
;        MOVCS   scrbyte, scrbyte, LSR #16
;        STRB    scrbyte, [screen], #1
;        MOV     scrbyte, scrbyte, LSR #8
;        STRB    scrbyte, [screen], linelen
;
;        AND     byte, mask, tophalf, LSL #8
;        LDR     scrbyte, [bigfont, byte, LSR #23]
;        MOVS    byte, tophalf, LSR #17
;        MOVCS   scrbyte, scrbyte, LSR #16
;        STRB    scrbyte, [screen], #1
;        MOV     scrbyte, scrbyte, LSR #8
;        STRB    scrbyte, [screen], linelen
;
;        AND     byte, mask, tophalf
;        LDR     scrbyte, [bigfont, byte, LSR #23]
;        MOVS    byte, tophalf, LSR #25
;        MOVCS   scrbyte, scrbyte, LSR #16
;        STRB    scrbyte, [screen], #1
;        MOV     scrbyte, scrbyte, LSR #8
;        STRB    scrbyte, [screen], linelen
;
;        AND     byte, mask, bottomhalf, LSL #24
;        LDR     scrbyte, [bigfont, byte, LSR #23]
;        MOVS    byte, bottomhalf, LSR #1
;        MOVCS   scrbyte, scrbyte, LSR #16
;        STRB    scrbyte, [screen], #1
;        MOV     scrbyte, scrbyte, LSR #8
;        STRB    scrbyte, [screen], linelen
;
;        AND     byte, mask, bottomhalf, LSL #16
;        LDR     scrbyte, [bigfont, byte, LSR #23]
;        MOVS    byte, bottomhalf, LSR #9
;        MOVCS   scrbyte, scrbyte, LSR #16
;        STRB    scrbyte, [screen], #1
;        MOV     scrbyte, scrbyte, LSR #8
;        STRB    scrbyte, [screen], linelen
;
;        AND     byte, mask, bottomhalf, LSL #8
;        LDR     scrbyte, [bigfont, byte, LSR #23]
;        MOVS    byte, bottomhalf, LSR #17
;        MOVCS   scrbyte, scrbyte, LSR #16
;        STRB    scrbyte, [screen], #1
;        MOV     scrbyte, scrbyte, LSR #8
;        STRB    scrbyte, [screen], linelen
;
;        AND     byte, mask, bottomhalf
;        LDR     scrbyte, [bigfont, byte, LSR #23]
;        MOVS    byte, bottomhalf, LSR #25
;        MOVCS   scrbyte, scrbyte, LSR #16
;        STRB    scrbyte, [screen], #1
;        MOV     scrbyte, scrbyte, LSR #8
;        STRB    scrbyte, [screen], linelen
;
; Messing around with this a bit, I found the following shorter & faster
; code:

        MOV     mask, #&7F
        SUB     linelen, linelen, #1

        ANDS    byte, mask, tophalf, LSR #1             ;C := bit 0 of tophalf
        LDR     scrbyte, [bigfont, byte, LSL #2]
        MOVCS   scrbyte, scrbyte, LSR #16
        STRB    scrbyte, [screen], #1
        MOV     scrbyte, scrbyte, LSR #8
        STRB    scrbyte, [screen], linelen

        ANDS    byte, mask, tophalf, LSR #9             ;C := bit 8 of tophalf
        LDR     scrbyte, [bigfont, byte, LSL #2]
        MOVCS   scrbyte, scrbyte, LSR #16
        STRB    scrbyte, [screen], #1
        MOV     scrbyte, scrbyte, LSR #8
        STRB    scrbyte, [screen], linelen

        ANDS    byte, mask, tophalf, LSR #17            ;C := bit 16 of tophalf
        LDR     scrbyte, [bigfont, byte, LSL #2]
        MOVCS   scrbyte, scrbyte, LSR #16
        STRB    scrbyte, [screen], #1
        MOV     scrbyte, scrbyte, LSR #8
        STRB    scrbyte, [screen], linelen

        ANDS    byte, mask, tophalf, LSR #25            ;C := bit 24 of tophalf
        LDR     scrbyte, [bigfont, byte, LSL #2]
        MOVCS   scrbyte, scrbyte, LSR #16
        STRB    scrbyte, [screen], #1
        MOV     scrbyte, scrbyte, LSR #8
        STRB    scrbyte, [screen], linelen

        ANDS    byte, mask, bottomhalf, LSR #1          ;C := bit 0 of b'half
        LDR     scrbyte, [bigfont, byte, LSL #2]
        MOVCS   scrbyte, scrbyte, LSR #16
        STRB    scrbyte, [screen], #1
        MOV     scrbyte, scrbyte, LSR #8
        STRB    scrbyte, [screen], linelen

        ANDS    byte, mask, bottomhalf, LSR #9          ;C := bit 8 of b'half
        LDR     scrbyte, [bigfont, byte, LSL #2]
        MOVCS   scrbyte, scrbyte, LSR #16
        STRB    scrbyte, [screen], #1
        MOV     scrbyte, scrbyte, LSR #8
        STRB    scrbyte, [screen], linelen

        ANDS    byte, mask, bottomhalf, LSR #17         ;C := bit 16 of b'half
        LDR     scrbyte, [bigfont, byte, LSL #2]
        MOVCS   scrbyte, scrbyte, LSR #16
        STRB    scrbyte, [screen], #1
        MOV     scrbyte, scrbyte, LSR #8
        STRB    scrbyte, [screen], linelen

        ANDS    byte, mask, bottomhalf, LSR #25         ;C := bit 24 of b'half
        LDR     scrbyte, [bigfont, byte, LSL #2]
        MOVCS   scrbyte, scrbyte, LSR #16
        STRB    scrbyte, [screen], #1
        MOV     scrbyte, scrbyte, LSR #8
        STRB    scrbyte, [screen], linelen

; *****End of change made by DJS

        LDR     R0, [WsPtr, #ModeFlags]         ; now test for non-BBC gap mode
        AND     R0, R0, #(ModeFlag_GapMode :OR: ModeFlag_BBCGapMode) ; we want R0=0 iff
        EORS    R0, R0, #ModeFlag_GapMode       ; (gapmode AND NOT bbcgapmode)
        MOVNE   PC, R14
        LDRB    scrbyte, [bigfont]              ; store backgd in next 2
        STRB    scrbyte, [screen], #1
        STRB    scrbyte, [screen], linelen
        STRB    scrbyte, [screen], #1
        STRB    scrbyte, [screen], linelen
        MOV     PC, R14

Wrch4bit
        MOV     R10, #0                         ; extra rows are 0 if not TTX
        LDR     R0, [WsPtr, #ModeFlags]         ; now test for non-BBC gap mode
        AND     R0, R0, #(ModeFlag_GapMode :OR: ModeFlag_BBCGapMode) ; we want R0=0 iff
        EOR     R0, R0, #ModeFlag_GapMode       ; (gapmode AND NOT bbcgapmode)
        MOV     mask, #&FF000000                ; don't set mask in Wrch4bitTTX
      [ :LNOT: HiResTTX
Wrch4bitTTX
      ]
        AND     byte, mask, tophalf, LSL #24
        LDR     scrbyte, [bigfont, byte, LSR #22]
        STR     scrbyte, [screen], linelen
        AND     byte, mask, tophalf, LSL #16
        LDR     scrbyte, [bigfont, byte, LSR #22]
        STR     scrbyte, [screen], linelen
        AND     byte, mask, tophalf, LSL #8
        LDR     scrbyte, [bigfont, byte, LSR #22]
        STR     scrbyte, [screen], linelen
        AND     byte, mask, tophalf
        LDR     scrbyte, [bigfont, byte, LSR #22]
        STR     scrbyte, [screen], linelen

        AND     byte, mask, bottomhalf, LSL #24
        LDR     scrbyte, [bigfont, byte, LSR #22]
        STR     scrbyte, [screen], linelen
        AND     byte, mask, bottomhalf, LSL #16
        LDR     scrbyte, [bigfont, byte, LSR #22]
        STR     scrbyte, [screen], linelen
        AND     byte, mask, bottomhalf, LSL #8
        LDR     scrbyte, [bigfont, byte, LSR #22]
        STR     scrbyte, [screen], linelen
        AND     byte, mask, bottomhalf
        LDR     scrbyte, [bigfont, byte, LSR #22]
        STR     scrbyte, [screen], linelen

        TEQ     R0, #0
        MOVNE   PC, R14
        AND     byte, mask, R10, LSL #8
        LDR     scrbyte, [bigfont, byte, LSR #22] ;get 1st extra (0 or for TTX)
        STR     scrbyte, [screen], linelen
        AND     byte, mask, R10
        LDR     scrbyte, [bigfont, byte, LSR #22] ;get 2nd extra (0 or for TTX)
        STR     scrbyte, [screen], linelen
        MOV     PC, R14

Wrch8bit
        MOV     mask, #&FF000000

        AND     byte, mask, tophalf, LSL #24
        ADD     byte, bigfont, byte, LSR #21
        LDMIA   byte, {scrbyte, scrbyte2}
        STMIA   screen, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen

        AND     byte, mask, tophalf, LSL #16
        ADD     byte, bigfont, byte, LSR #21
        LDMIA   byte, {scrbyte, scrbyte2}
        STMIA   screen, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen

        AND     byte, mask, tophalf, LSL #8
        ADD     byte, bigfont, byte, LSR #21
        LDMIA   byte, {scrbyte, scrbyte2}
        STMIA   screen, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen

        AND     byte, mask, tophalf
        ADD     byte, bigfont, byte, LSR #21
        LDMIA   byte, {scrbyte, scrbyte2}
        STMIA   screen, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen

        AND     byte, mask, bottomhalf, LSL #24
        ADD     byte, bigfont, byte, LSR #21
        LDMIA   byte, {scrbyte, scrbyte2}
        STMIA   screen, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen

        AND     byte, mask, bottomhalf, LSL #16
        ADD     byte, bigfont, byte, LSR #21
        LDMIA   byte, {scrbyte, scrbyte2}
        STMIA   screen, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen

        AND     byte, mask, bottomhalf, LSL #8
        ADD     byte, bigfont, byte, LSR #21
        LDMIA   byte, {scrbyte, scrbyte2}
        STMIA   screen, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen

        AND     byte, mask, bottomhalf
        ADD     byte, bigfont, byte, LSR #21
        LDMIA   byte, {scrbyte, scrbyte2}
        STMIA   screen, {scrbyte, scrbyte2}

        [ 1=0 ; *** No 8 bpc non-BBC gap modes at present ***
        LDR     R0, [WsPtr, #ModeFlags]         ; now test for non-BBC gap mode
        AND     R0, R0, #(ModeFlag_GapMode :OR: ModeFlag_BBCGapMode) ; we want R0=0 iff
        EORS    R0, R0, #ModeFlag_GapMode       ; (gapmode AND NOT bbcgapmode)
        MOVNE   PC, R14
        LDMIA   bigfont, {scrbyte, scrbyte2}    ; store backgd in next 2
        ADD     screen, screen, linelen
        STMIA   screen, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen
        STMIA   screen, {scrbyte, scrbyte2}
        ]
        MOV     PC, R14

Wrch16bit
        MOV     mask, #&FF000000
        SUB     linelen, linelen, #16

        AND     byte, mask, tophalf, LSL #24
        ADD     byte, bigfont, byte, LSR #20
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen

        AND     byte, mask, tophalf, LSL #16
        ADD     byte, bigfont, byte, LSR #20
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen

        AND     byte, mask, tophalf, LSL #8
        ADD     byte, bigfont, byte, LSR #20
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen

        AND     byte, mask, tophalf
        ADD     byte, bigfont, byte, LSR #20
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen

        AND     byte, mask, bottomhalf, LSL #24
        ADD     byte, bigfont, byte, LSR #20
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen

        AND     byte, mask, bottomhalf, LSL #16
        ADD     byte, bigfont, byte, LSR #20
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen

        AND     byte, mask, bottomhalf, LSL #8
        ADD     byte, bigfont, byte, LSR #20
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen

        AND     byte, mask, bottomhalf
        ADD     byte, bigfont, byte, LSR #20
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        LDMIA   byte!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}

        [ 1=0 ; *** No 16 bpc non-BBC gap modes at present ***
        LDR     R0, [WsPtr, #ModeFlags]         ; now test for non-BBC gap mode
        AND     R0, R0, #(ModeFlag_GapMode :OR: ModeFlag_BBCGapMode) ; we want R0=0 iff
        EORS    R0, R0, #ModeFlag_GapMode       ; (gapmode AND NOT bbcgapmode)
        MOVNE   PC, R14
        LDMIA   bigfont, {scrbyte, scrbyte2}    ; store backgd in next 2
        ADD     screen, screen, linelen
        STMIA   screen!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        ADD     screen, screen, linelen
        STMIA   screen!, {scrbyte, scrbyte2}
        STMIA   screen!, {scrbyte, scrbyte2}
        ]
        MOV     PC, R14

; *****************************************************************************

; Write a character at 32 bit per pixel
;
; NB: This code assumes that we have no concept of gap modes.

Wrch32bit
        Push    "R0-R1,R5-R7,R9-R10,R12,LR"

        MOV     mask, #&FF000000

        AND     byte, mask, tophalf, LSL #24
        ADD     byte, bigfont, byte, LSR #19
        LDMIA   byte,   {R0,R1, R6,R7, R9,R10, R12,LR}
        STMIA   screen, {R0,R1, R6,R7, R9,R10, R12,LR}
        ADD     screen, screen, linelen

        AND     byte, mask, tophalf, LSL #16
        ADD     byte, bigfont, byte, LSR #19
        LDMIA   byte,   {R0,R1, R6,R7, R9,R10, R12,LR}
        STMIA   screen, {R0,R1, R6,R7, R9,R10, R12,LR}
        ADD     screen, screen, linelen

        AND     byte, mask, tophalf, LSL #8
        ADD     byte, bigfont, byte, LSR #19
        LDMIA   byte,   {R0,R1, R6,R7, R9,R10, R12,LR}
        STMIA   screen, {R0,R1, R6,R7, R9,R10, R12,LR}
        ADD     screen, screen, linelen

        AND     byte, mask, tophalf
        ADD     byte, bigfont, byte, LSR #19
        LDMIA   byte,   {R0,R1, R6,R7, R9,R10, R12,LR}
        STMIA   screen, {R0,R1, R6,R7, R9,R10, R12,LR}
        ADD     screen, screen, linelen

        LDR     bottomhalf, [SP, #4*3]                  ; restore 'bottomhalf' (R6 pushed onto stack)

        AND     byte, mask, bottomhalf, LSL #24
        ADD     byte, bigfont, byte, LSR #19
        LDMIA   byte,   {R0,R1, R5,R7, R9,R10, R12,LR}
        STMIA   screen, {R0,R1, R5,R7, R9,R10, R12,LR}
        ADD     screen, screen, linelen

        AND     byte, mask, bottomhalf, LSL #16
        ADD     byte, bigfont, byte, LSR #19
        LDMIA   byte,   {R0,R1, R5,R7, R9,R10, R12,LR}
        STMIA   screen, {R0,R1, R5,R7, R9,R10, R12,LR}
        ADD     screen, screen, linelen

        AND     byte, mask, bottomhalf, LSL #8
        ADD     byte, bigfont, byte, LSR #19
        LDMIA   byte,   {R0,R1, R5,R7, R9,R10, R12,LR}
        STMIA   screen, {R0,R1, R5,R7, R9,R10, R12,LR}
        ADD     screen, screen, linelen

        AND     byte, mask, bottomhalf
        ADD     byte, bigfont, byte, LSR #19
        LDMIA   byte,   {R0,R1, R5,R7, R9,R10, R12,LR}
        STMIA   screen, {R0,R1, R5,R7, R9,R10, R12,LR}
        ADD     screen, screen, linelen

        Pull    "R0-R1,R5,R6,R7,R9-R10,R12,PC"


; *****************************************************************************
;
;       BS - Backspace
;       move cursor "left"
;
; in:   R6 = CursorFlags
;

BS
        TST     R6, R6, ROR #10                 ; test &1E or C81Bit or Vdu5
        BNE     SpecialBS

        LDR     R0, [WsPtr, #CursorX]
        LDR     R2, [WsPtr, #CursorAddr]
        LDR     R3, [WsPtr, #CharWidth]
        LDR     R4, [WsPtr, #TWLCol]

        SUB     R0, R0, #1                      ; no Master wazerks yet !
        SUB     R2, R2, R3
        CMP     R0, R4
        STRGE   R0, [WsPtr, #CursorX]           ; I do mean GE !
        STRGE   R2, [WsPtr, #CursorAddr]
        MOVGE   PC, R14

        LDR     R0, =ZeroPage
        LDRB    R1, [R0, #OsbyteVars + :INDEX: PageModeLineCount]
        TEQ     R1, #0
        SUBNE   R1, R1, #1
        STRB    R1, [R0, #OsbyteVars + :INDEX: PageModeLineCount]

        LDR     R0, [WsPtr, #TWRCol]
        LDR     R1, [WsPtr, #CursorY]
        LDR     R4, [WsPtr, #TWTRow]

        SUB     R1, R1, #1
        CMP     R1, R4

        BGE     CursorR0R1

        STR     R0, [WsPtr, #CursorX]
        BSR     ScrollDown
        B       AddressCursor

; *****************************************************************************
;
;       Horizontal TAB - ie move cursor "right"
;
; in:   R6 = CursorFlags
;

HT
        TST     R6, R6, ROR #10 ; test for &1E or C81Bit or Vdu5
        BNE     SpecialHT

        LDR     R0, [WsPtr, #CursorX]
        LDR     R2, [WsPtr, #CursorAddr]
        LDR     R3, [WsPtr, #CharWidth]
        LDR     R4, [WsPtr, #TWRCol]

        ADD     R0, R0, #1
        ADD     R2, R2, R3
        CMP     R0, R4
        STRLS   R0, [WsPtr, #CursorX]
        STRLS   R2, [WsPtr, #CursorAddr]
        MOVLS   PC, R14

        BSR     PageTest

        LDR     R0, [WsPtr, #TWLCol]
        LDR     R1, [WsPtr, #CursorY]
        LDR     R4, [WsPtr, #TWBRow]

        ADD     R1, R1, #1
        CMP     R1, R4
        BLS     CursorR0R1                       ; not on bottom line

        STR     R0, [WsPtr, #CursorX]
        BSR     ScrollUp
        B       AddressCursor                    ; re-address cursor position

; *****************************************************************************
;
;       VduLF - Line feed
;
; in:   R6 = CursorFlags
;

VduLF
        TST     R6, #Vdu5Bit
        BNE     Vdu5LF

        BSR     PageTest                ; check for CTRL/SHIFT, page mode

        TST     R6, R6, ROR #10
        BNE     SpecialLF

        LDR     R1, [WsPtr, #CursorY]
        LDR     R2, [WsPtr, #CursorAddr]
        LDR     R3, [WsPtr, #RowLength]
        LDR     R4, [WsPtr, #TWBRow]

        ADD     R1, R1, #1                      ; no Master wazerks
        ADD     R2, R2, R3
        CMP     R1, R4
        STRLS   R1, [WsPtr, #CursorY]
        STRLS   R2, [WsPtr, #CursorAddr]
        MOVLS   PC, R14

        BSR     ScrollUp
        B       AddressCursor

; *****************************************************************************
;
;       VT - Cursor up
;

VT
        LDR     R6, [WsPtr, #CursorFlags]
        TST     R6, #Vdu5Bit
        BNE     Vdu5VT

        LDR     R0, =ZeroPage
        LDRB    R1, [R0, #OsbyteVars + :INDEX: PageModeLineCount]
        TEQ     R1, #0
        SUBNE   R1, R1, #1
        STRB    R1, [R0, #OsbyteVars + :INDEX: PageModeLineCount]

        TST     R6, R6, ROR #10
        BNE     SpecialVT

        LDR     R1, [WsPtr, #CursorY]
        LDR     R2, [WsPtr, #CursorAddr]
        LDR     R3, [WsPtr, #RowLength]
        LDR     R4, [WsPtr, #TWTRow]

        SUB     R1, R1, #1
        SUB     R2, R2, R3
        CMP     R1, R4
        STRGE   R1, [WsPtr, #CursorY]
        STRGE   R2, [WsPtr, #CursorAddr]
        MOVGE   PC, R14

        BSR     ScrollDown
        B       AddressCursor

; *****************************************************************************
;
;       VduCR - Carriage return
;       move to "left" boundary
;
; in:   R6 = CursorFlags
;
; out:  R6 = updated CursorFlags

VduCR
CR10                            ; entry point for releasing pending CRLF
        TST     R6, #Vdu5Bit
        BNE     Vdu5CR

        BIC     R6, R6, #C81Bit                 ; destroy pending CRLF
        STR     R6, [WsPtr, #CursorFlags]
        Push    R14
        BL      CursorB0                        ; preserves R6
        BL      AddressCursor                   ; preserves R6
        Pull    PC

; *****************************************************************************
;
;       FS - Define text window
;

FS      ROUT
        LDRB    R0, [WsPtr, #QQ+0]              ; left
        LDRB    R1, [WsPtr, #QQ+1]              ; bottom
        LDRB    R2, [WsPtr, #QQ+2]              ; right
        LDRB    R3, [WsPtr, #QQ+3]              ; top
        LDR     R4, [WsPtr, #ScrRCol]           ; max right
        LDR     R5, [WsPtr, #ScrBRow]           ; max bottom

        LDR     R6, [WsPtr, #VduStatus]
        ORR     R6, R6, #Windowing              ; we are windowing
        STR     R6, [WsPtr, #VduStatus]

; Secondary entry point, for validating unpacked context variables
; NB doesn't want to set windowing bit

FSRegs
        CMP     R2, R0                          ; right >= left
        CMPCS   R4, R2                          ; max right >= right
        CMPCS   R1, R3                          ; bottom >= top
        CMPCS   R5, R1                          ; max bottom >= bottom
        MOVCC   PC, R14                         ; invalid window

        ADD     R6, WsPtr, #TWLCol
        STMIA   R6, {R0-R3}                     ; write new window settings

; now check for input cursor being outside window

        LDR     R6, [WsPtr, #CursorFlags]
        TST     R6, #CursorsSplit
        BEQ     %FT10                           ; [cursors not split]

        ASSERT  InputCursorY = InputCursorX +4
        ADD     R6, WsPtr, #InputCursorX        ; R6 := InputCursorX
        LDMIA   R6, {R6, R7}                    ; R7 := InputCursorY

        CMP     R6, R0                          ; X >= left
        CMPCS   R2, R6                          ; right >= X
        CMPCS   R7, R3                          ; Y >= top
        CMPCS   R1, R7                          ; bottom >= Y

        BCS     %FT10                           ; [not outside window]

        LDR     R6, [WsPtr, #CursorX]           ; get output cursor posn
        LDR     R7, [WsPtr, #CursorY]
        LDR     R4, [WsPtr, #CursorAddr]
        Push    "R0-R4, R6, R7, R14"            ; save window and output cursor

        BL      HomeVdu4                        ; Home output cursor

        LDR     R6, [WsPtr, #CursorX]           ; Copy output ...
        LDR     R7, [WsPtr, #CursorY]
        LDR     R4, [WsPtr, #CursorAddr]

        STR     R6, [WsPtr, #InputCursorX]      ; ... to input
        STR     R7, [WsPtr, #InputCursorY]
        STR     R4, [WsPtr, #InputCursorAddr]

        Pull    "R0-R4, R6, R7, R14"            ; restore old registers
        STR     R6, [WsPtr, #CursorX]
        STR     R7, [WsPtr, #CursorY]
        STR     R4, [WsPtr, #CursorAddr]
10

; now check output cursor is inside window

        LDR     R6, [WsPtr, #CursorX]           ; get output cursor posn
        LDR     R7, [WsPtr, #CursorY]

        CMP     R6, R0                          ; X >= left
        CMPCS   R2, R6                          ; right >= X
        CMPCS   R7, R3                          ; Y >= top
        CMPCS   R1, R7                          ; bottom >= Y

        MOVCS   PC, R14                         ; cursor inside window

; and drop thru to ...

HomeVdu4                                        ; home TEXT cursor, even in
                                                ; VDU 5 mode
        MOV     R0, #0                          ; move to "0,0"
        MOV     R1, #0
        LDR     R6, [WsPtr, #CursorFlags]

        B       TabR0R1NotVdu5                  ; (destroys any pending CRLF)

; *****************************************************************************
;
;       TCOL - Set text colour (foreground or background)
;
        ASSERT  TBackCol = TForeCol +4
        ASSERT  back > fore

TCOL
DC1
        TST     R6, #TeletextMode               ; if in teletext
        MOVNE   PC, R14                         ; then ignore

        LDR     bpp, [WsPtr, #BitsPerPix]
        ADD     fore, WsPtr, #TForeCol
        LDMIA   fore, {fore, back}

        LDR     R3, [WsPtr, #NColour]
        LDRB    R4, [WsPtr, #QQ+0]              ; get colour specified
        CMP     R4, #128                        ; C=1 => set background
        AND     R4, R4, R3
        AND     R4, R4, #63                     ; oh no not again!
        STRCC   R4, [WsPtr, #TForeCol]
        STRCS   R4, [WsPtr, #TBackCol]
        MOVCC   R5, fore
        MOVCS   R5, back                        ; R5 is old appropriate colour
        MOVCC   fore, R4
        MOVCS   back, R4

        BCS     %FT31                           ; branch for background

        ; amg: only update the appropriate one
        CMP     R4,R5
        MOVEQ   PC, R14
        Push    "LR"
        BL      CompileTextFg
        Pull    "LR"
        B       %FT32
31
        CMP     R4, R5
        MOVEQ   PC, R14                         ; same as last time
        Push    "LR"
        BL      CompileTextBg                   ; ensure that TextBg is kosher
        Pull    "LR"                            ;   preserving the return address
32
        LDR     R6, [WsPtr, #CursorFlags]
        ORR     R6, R6, #TEUpdate
R6toCursorFlags
        STR     R6, [WsPtr, #CursorFlags]

        MOV     PC, R14

CheckTEUpdate
        LDR     R6, [WsPtr, #CursorFlags]
        TST     R6, #TEUpdate
        MOVEQ   PC, R14
ReallySetColours
        BIC     R6, R6, #TEUpdate
        STR     R6, [WsPtr, #CursorFlags]       ; clear update flag

        Push    "R6, R14"
        LDR     bpp, [WsPtr, #BitsPerPix]
        LDR     fore, [WsPtr, #TextFgColour]
        LDR     back, [WsPtr, #TextBgColour]
        BL      SetColours
        Pull    "R6, PC"

; *****************************************************************************
;
;       FF - Clear text window (CLS)
;

FF
        LDR     R6, [WsPtr, #CursorFlags]
        TST     R6, #Vdu5Bit
        BNE     Vdu5FF

        ASSERT  (ZeroPage :AND: 255) = 0
        STROSB  R0, PageModeLineCount, R0       ; zero page mode line count

        LDR     R0, [WsPtr, #VduStatus]
        TST     R0, #Windowing
        BNE     SlowCLS                         ; windowing, so do slowly

        Push    R14
        TST     R6, #ClipBoxEnableBit
        BLNE    SetClipBoxToFullScreen
        LDR     R0, [WsPtr, #DriverBankAddr]    ; set driver's screen start
        STR     R0, [WsPtr, #ScreenStart]
        BL      SetDisplayScreenStart

        LDR     R0, [WsPtr, #DisplayBankAddr]
        BL      SetVinit                        ; program Vinit
                                                ; (and set DisplayStart)
        BL      Home       ; home cursor after ScreenStart initialised
        TST     R6, #CursorsSplit
        BLNE    AddressInputCursor
        Pull    R14

        LDR     R0, [WsPtr, #ModeFlags]
        TST     R0, #ModeFlag_BBCGapMode        ; if not BBC gap mode
        BEQ     FastCLS                         ; then use fast code

SlowCLS
        BSR     Home

        ADD     R0, WsPtr, #TWLCol              ; R0 := TWLCol; R1 := TWBRow
        LDMIA   R0, {R0-R3}                     ; R2 := TWRCol; R3 := TWTRow

;       and drop thru to ...

;       ClearBox - Clears a box of text chars on the screen
;
; in:   R0 = left column
;       R1 = bottom row
;       R2 = right column
;       R3 = top row

ClearBox ROUT
        Push    R14
        TST     R6, #ClipBoxEnableBit
        BLNE    ClipTextArea

        TST     R6, #TeletextMode
        BNE     TTXClearBox

        BL      GetBoxInfo
        Pull    R14

ClearThisBox
        STR     R8, [WsPtr, #RowsToDo]

        LDR     R9, [WsPtr, #CursorFlags]
        TST     R9, #TEUpdate
        BNE     %FT99

05
        LDR     R8, [WsPtr, #TextBgColour]
        LDRB    R1, [WsPtr, #ModeFlags]
        TST     R1, #ModeFlag_BBCGapMode ; is it a BBC gap mode ?
        LDRNE   R1, =&AAAAAAAA          ; use colour 2 for gaps if so
        MOVEQ   R1, R8                  ; else use background colour
        EOR     R1, R1, R8              ; EOR toggle for colour
        STR     R1, [WsPtr, #EORtoggle]
        LDR     R0, [WsPtr, #RowMult]   ; 8 or 10

ClearRow
        MOV     R6, #0
ClearLineNew
        MOV     R9, R8
        MOV     R10, R8
        MOV     R11, R8
ClearLine
        MOV     R1, R2                  ; R1 is current address
        ADD     R3, R2, R5              ; R3 is byte after last one
10
        CMP     R1, R3
        BEQ     DoneLine
        TST     R1, #3
        STRNEB  R8, [R1], #1            ; store if not on word boundary
        BNE     %BT10

        SUB     R4, R3, R1              ; number of bytes left on this line
        MOV     R4, R4, LSR #4          ; number of 4-words left on this line
        SUBS    R4, R4, #1              ; C=0 if 0, C=1 if >0
14
        STMHIIA R1!, {R8-R11}           ; done if R4 > 0
        STMCSIA R1!, {R8-R11}           ; done if R4 >= 0
        SUBCSS  R4, R4, #2              ; this code dropped thru if R4 was 0
        BCS     %BT14

        BIC     R4, R3, #3
20
        CMP     R1, R4
        STRNE   R8, [R1], #4
        BNE     %BT20

30
        CMP     R1, R3
        STRNEB  R8, [R1], #1
        BNE     %BT30

DoneLine
        ADD     R2, R2, R7
        ADD     R6, R6, #1
        CMP     R6, #8
        BCC     ClearLine
        LDR     R1, [WsPtr, #EORtoggle]
        EOREQ   R8, R8, R1
        CMP     R6, R0
        BCC     ClearLineNew

        EOR     R8, R8, R1
        LDR     R1, [WsPtr, #RowsToDo]
        SUBS    R1, R1, #1
        STR     R1, [WsPtr, #RowsToDo]
        BNE     ClearRow

        MOV     PC, R14

99
        Push    "R2, R5-R7, R14"
        MOV     R6, R9
        BL      ReallySetColours
        Pull    "R2, R5-R7, R14"
        B       %BT05

        LTORG

; *****************************************************************************
;
;       GetWindowInfo - sets up some info for current text window
;
;       GetBoxInfo - sets up some info for a given box
;
; in:   R0 = left
;       R1 = bottom
;       R2 = right
;       R3 = top
;
; out:  R2 = address of top left
;       R5 = number of bytes horizontally
;       R6 = number of pixel rows vertically
;       R7 = LineLength
;       R8 = number of character rows vertically

GetWindowInfo
        ADD     R0, WsPtr, #TWLCol              ; R0 := TWLCol; R1 := TWBRow
        LDMIA   R0, {R0-R3}                     ; R2 := TWRCol; R3 := TWTRow
GetBoxInfo
        SUB     R5, R2, R0
        ADD     R5, R5, #1                      ; number of chars horiz
        LDR     R6, [WsPtr, #CharWidth]         ; should be bytes/char
        MUL     R5, R6, R5                      ; number of bytes horiz

        SUB     R6, R1, R3
        ADD     R8, R6, #1                      ; number of char rows vert

        LDR     R7, [WsPtr, #ModeFlags]

        MOV     R6, R8, LSL #3                  ; *8
        TST     R7, #ModeFlag_GapMode           ; if gap mode
        ADDNE   R6, R6, R8, LSL #1              ; (+*2) = *10
        TST     R7, #ModeFlag_DoubleVertical    ; if double mode
        ADDNE   R6, R6, R6                      ; then double

        LDR     R7, [WsPtr, #LineLength]

        MOV     R1, R3                          ; prepare to address top left
        B       AddressR0R1

;
;       TextWindowToGraphics - current text window converted to graphics
;
;       TextBoxToGraphics - given text box converted to graphics coordinates
;
; in:   R0 = left
;       R1 = bottom
;       R2 = right
;       R3 = top
;
; out:  R0-R3 converted to internal graphics coordinates
;       R5 = number of pixels horizontally
;       R6 = number of pixel rows vertically
;       R7 = row height in pixels
;       R8 = number of character rows vertically

ScreenToGraphics
        MOV     R0, #0
        LDR     R1, [WsPtr, #ScrBRow]
        LDR     R2, [WsPtr, #ScrRCol]
        MOV     R3, #0
        B       TextBoxToGraphics

TextWindowToGraphics
        ADD     R0, WsPtr, #TWLCol              ; R0 := TWLCol; R1 := TWBRow
        LDMIA   R0, {R0-R3}                     ; R2 := TWRCol; R3 := TWTRow
TextBoxToGraphics
        SUB     R5, R2, R0
        ADD     R5, R5, #1                      ; number of chars horiz

        LDR     R6, [WsPtr, #CharWidth]         ; bytes/char (not log2)
        LDR     R7, [WsPtr, #Log2BPP]           ; log2 bits/pixel

        MUL     R0, R6, R0                      ; number of bytes horiz
        MUL     R5, R6, R5
        SUB     R7, R7, #3                      ; log2 bytes/pixel

        MOV     R0, R0, LSR R7                  ; number of pixels horiz
        MOV     R5, R5, LSR R7
        ADD     R2, R0, R5                      ; recalculate right coord
        SUB     R2, R2, #1

        LDR     R7, [WsPtr, #TCharSizeY]

        SUB     R8, R1, R3
        ADD     R8, R8, #1                      ; number of char rows vert
        MUL     R3, R7, R3                      ; convert top to pixels (from top)
        MUL     R6, R7, R8                      ; convert height to pixels
        LDR     R1, [WsPtr, #YWindLimit]
        SUB     R3, R1, R3                      ; Y-flip coordinate (bottom-left = 0,0)
        SUB     R1, R3, R6                      ; recalculate bottom coord
        ADD     R1, R1, #1

        MOV     PC, R14

; *****************************************************************************
;
;       US - TAB(X,Y)
;

US
        LDRB    R0, [WsPtr, #QQ+0]
        LDRB    R1, [WsPtr, #QQ+1]
TabR0R1

        LDR     R6, [WsPtr, #CursorFlags]
        TST     R6, #Vdu5Bit
        BNE     Vdu5TAB

TabR0R1NotVdu5
        LDR     R9,  [WsPtr, #CursorX]
        LDR     R10, [WsPtr, #CursorY]
        Push    "R0,R9,R10"             ; save old X,Y in case it doesn't work

        EOR     R6, R6, #8              ; update Y position
        MOV     R0, R1
        BSR     CursorBdy

        EOR     R6, R6, #8              ; now try X position
        Pull    R0
        BSR     CursorBdyCheck
        MOV     R7, #0                  ; will be clearing C81Bit
        BCS     US10                    ; was in window, so OK

        TEQ     R6, R6, LSR #1          ; are we in 81 column mode
                                        ; (just want to set carry)
        BCC     US20                    ; can't do it

        SUB     R0, R0, #1              ; could be attempt to move to col 81
        BSR     CursorBdyCheck
        BCC     US20                    ; still can't do it
        MOV     R7, #C81Bit             ; set C81Bit
US10
        BIC     R6, R6, #C81Bit
        ORR     R6, R6, R7
        STR     R6, [WsPtr, #CursorFlags]

US20
        Pull    "R9,R10"

        STRCC   R9,  [WsPtr, #CursorX]  ; couldn't do it, so restore position
        STRCC   R10, [WsPtr, #CursorY]

        B       AddressCursor

; *****************************************************************************
;
;       ScrollUp - Scroll the current text window up
;

ScrollUp
        LDR     R0, [WsPtr, #VduStatus]
        TST     R0, #Windowing
        BNE     SoftScrollUp
HardScrollUp
        LDR     R1, [WsPtr, #ModeFlags]
        TST     R1, #ModeFlag_HardScrollDisabled
        BNE     HardScrollSpriteUp

        Push    R14
        LDR     R1, [WsPtr, #RowLength]
        LDR     R2, [WsPtr, #TotalScreenSize]
        LDR     R14, [WsPtr, #ScreenEndAddr]

        LDR     R0, [WsPtr, #DisplayScreenStart]
        ADD     R0, R0, R1
        CMP     R0, R14
        SUBCS   R0, R0, R2
        BL      SetDisplayScreenStart
        LDR     R14, [WsPtr, #ScreenEndAddr]
        STR     R0, [WsPtr, #ScreenStart]

        LDR     R0, [WsPtr, #DisplayStart]
        ADD     R0, R0, R1
        CMP     R0, R14
        SUBCS   R0, R0, R2

        BL      SetVinit                ; program vinit and set DisplayStart

        TST     R6, #TeletextMode
        BLNE    TTXHardScrollUp
        Pull    R14

ClearBottomScreenLine
        MOV     R0, #0                          ; Don't use window coords -
        LDR     R1, [WsPtr, #ScrBRow]           ; code also used in VDU23,7
        LDR     R2, [WsPtr, #ScrRCol]
        MOV     R3, R1
        B       ClearBox

; Code to scroll whole 'screen' up, when hard scroll disabled
; (ie outputting to sprite)

HardScrollSpriteUp
        Push    R14
        TST     R6, #TeletextMode
        BNE     TTXSoftScrollUp
        BL      TryCopyScreenUp
        Pull    R14,EQ
        BEQ     ClearBottomScreenLine
        BL      GetScreenInfo           ; get box info for whole 'screen'
        LDR     R0, [WsPtr, #RowMult]
        BL      SoftScrollUp2
        Pull    R14
        B       ClearBottomScreenLine

; Clear bottom line of window

ClearBottomLine
        ADD     R0, WsPtr, #TWLCol              ; R0 := TWLCol; R1 := TWBRow
        LDMIA   R0, {R0-R2}                     ; R2 := TWRCol
        MOV     R3, R1                          ; R3 := TWBRow
        B       ClearBox

SoftScrollUp
        Push    R14
        TST     R6, #TeletextMode
        BNE     TTXSoftScrollUp

        BL      TryCopyWindowUp
        Pull    R14, EQ
        BEQ     ClearBottomLine
        BL      GetWindowInfo

;       R2 = address of top left
;       R5 = number of bytes horizontally
;       R6 = number of pixel rows in box
;       R7 = linelength
;       R8 = number of character rows in box

        LDR     R0, [WsPtr, #RowMult]
        BL      SoftScrollUp2
        Pull    R14
        B       ClearBottomLine

; *****************************************************************************
;
;       SoftScrollUp2 - Called by SoftScrollUp and by Teletext to scroll map
;
; in:   R0 = RowMult
;       R2 = screen address of top left of area to scroll
;       R5 = number of bytes horizontally
;       R6 = number of pixel rows vertically
;       R7 = linelength
;

SoftScrollUp2 ROUT
        SUBS    R6, R6, R0              ; scroll number of rows-1
        MOVEQ   PC, R14                 ; single row window, nowt to scroll

ScrollLineUp
        MOV     R1, R2
        LDR     R3, [WsPtr, #RowLength]
        ADD     R0, R1, R3              ; R0 -> line below
        ADD     R3, R2, R5              ; R3 -> byte after last one on upper
10
        CMP     R1, R3
        BEQ     %FT40                   ; finished
        TST     R1, #3                  ; if not word aligned
        LDRNEB  R8, [R0], #1            ; then copy a byte
        STRNEB  R8, [R1], #1
        BNE     %BT10

        SUB     R4, R3, R1              ; number of bytes left on this line
        MOVS    R4, R4, LSR #4          ; number of 4-words left on this line
        SUBS    R4, R4, #1              ; C=0 if 0, C=1 if >0
14
        LDMHIIA R0!, {R8-R11}           ; this code dropped thru if was 0
        STMHIIA R1!, {R8-R11}
        LDMCSIA R0!, {R8-R11}
        STMCSIA R1!, {R8-R11}
        SUBCSS  R4, R4, #2
        BCS     %BT14

        BIC     R4, R3, #3
20
        CMP     R1, R4
        LDRNE   R8, [R0], #4
        STRNE   R8, [R1], #4
        BNE     %BT20

30
        CMP     R1, R3
        LDRNEB  R8, [R0], #1
        STRNEB  R8, [R1], #1
        BNE     %BT30

40
        ADD     R2, R2, R7
        SUBS    R6, R6, #1
        BNE     ScrollLineUp

        MOV     PC, R14

; *****************************************************************************
;
;       TryCopyScreenUp - use GraphicsV to copy screen up
;
; in:   nothing
; out:  R0-R11 corrupted
;       Z flag set if successful

TryCopyScreenUp
        Push    R14
        BL      CheckAcceleration
        Pull    PC, NE                  ; return with Z clear (unsuccessful)
        BL      ScreenToGraphics
TryCopyUpCommon
        SUB     R4, R2, R0              ; width-1
        SUB     R5, R3, R1              ; height-1
        SUBS    R5, R5, R7              ; less one row
        Pull    PC,MI                   ; return with Z clear (unsuccessful)
        MOV     R2, R0                  ; dstL=srcL
        ADD     R3, R1, R7              ; dstB=srcB +1row
TryCopyCommon
        Push    "R0-R5"
        MOV     R0, #GVRender_Sync
        MOV     R1, #GVRender_CopyRectangle
        MOV     R2, R13
        LDR     R4, [WsPtr, #CurrentGraphicsVDriver]
        MOV     R4, R4, LSL #24
        ORR     R4, R4, #GraphicsV_Render
        BL      CallGraphicsV
        ADD     R13, R13, #6*4
        TEQ     R4, #GraphicsV_Complete
        Pull    PC

; .............................................................................
;
;       TryCopyWindowUp - use GraphicsV to copy window up
;
; in:   nothing
; out:  R0-R11 corrupted
;       Z flag set if successful

TryCopyWindowUp
        LDR     R0, [WsPtr, #VduSprite]
        TEQ     R0, #0                  ; don't try it if outputting to sprite
        MOVNE   PC, R14                 ; return with Z clear (unsuccessful)
        Push    R14
        ADR     R14, TryCopyUpCommon
        B       TextWindowToGraphics

; *****************************************************************************
;
;       TryCopyScreenDown - use GraphicsV to copy screen down
;
; in:   nothing
; out:  R0-R11 corrupted
;       Z flag set if successful

TryCopyScreenDown
        Push    R14
        BL      CheckAcceleration
        Pull    PC, NE                  ; return with Z clear (unsuccessful)
        BL      ScreenToGraphics
TryCopyDownCommon
        SUB     R4, R2, R0              ; width-1
        SUB     R5, R3, R1              ; height-1
        SUBS    R5, R5, R7              ; less one row
        Pull    PC,MI                   ; return with Z clear (unsuccessful)
        MOV     R2, R0                  ; dstL=srcL
        MOV     R3, R1                  ; dstB=bot
        ADD     R1, R1, R7              ; srcB=bot +1row
        B       TryCopyCommon

; .............................................................................
;
;       TryCopyWindowDown - use GraphicsV to copy window down
;
; in:   nothing
; out:  R0-R11 corrupted
;       Z flag set if successful

TryCopyWindowDown
        LDR     R0, [WsPtr, #VduSprite]
        TEQ     R0, #0                  ; don't try it if outputting to sprite
        MOVNE   PC, R14                 ; return with Z clear (unsuccessful)
        Push    R14
        ADR     R14, TryCopyDownCommon
        B       TextWindowToGraphics

; *****************************************************************************
;
;       ScrollDown - Scroll the current text window down
;

ScrollDown
        LDR     R0, [WsPtr, #VduStatus]
        TST     R0, #Windowing
        BNE     SoftScrollDown
HardScrollDown
        LDR     R1, [WsPtr, #ModeFlags]
        TST     R1, #ModeFlag_HardScrollDisabled
        BNE     HardScrollSpriteDown

        Push    R14
        LDR     R1, [WsPtr, #RowLength]
        LDR     R2, [WsPtr, #TotalScreenSize]
        LDR     R14, [WsPtr, #ScreenEndAddr]

        LDR     R0, [WsPtr, #DisplayScreenStart]
        SUB     R0, R0, R1                      ; down one row
        ADD     R3, R0, R2
        CMP     R3, R14                         ; if < then need wrap
        MOVCC   R0, R3
        BL      SetDisplayScreenStart
        LDR     R14, [WsPtr, #ScreenEndAddr]
        STR     R0, [WsPtr, #ScreenStart]

        LDR     R0, [WsPtr, #DisplayStart]
        SUB     R0, R0, R1
        ADD     R3, R0, R2
        CMP     R3, R14
        MOVCC   R0, R3

        BL      SetVinit                ; program vinit and set DisplayStart

        TST     R6, #TeletextMode
        BLNE    TTXHardScrollDown
        Pull    R14

ClearTopScreenLine
        MOV     R0, #0                          ; don't use window coords -
        MOV     R1, #0                          ; code also used by VDU23,7
        LDR     R2, [WsPtr, #ScrRCol]
        MOV     R3, #0
        B       ClearBox

; Code to scroll whole 'screen' down, when hard scroll disabled
; (ie outputting to sprite)

HardScrollSpriteDown
        Push    R14
        TST     R6, #TeletextMode
        BNE     TTXSoftScrollDown
        BL      TryCopyScreenDown
        Pull    R14, EQ
        BEQ     ClearTopLine
        BL      GetScreenInfo           ; get box info for whole 'screen'

        MOV     R0, #0
        LDR     R1, [WsPtr, #ScrBRow]
        BL      AddressR0R1             ; R2 -> top line of bottom left char

        LDR     R0, [WsPtr, #RowMult]
        BL      SoftScrollDown2
        Pull    R14
        B       ClearTopScreenLine

; Clear top line of window

ClearTopLine
        ADD     R0, WsPtr, #TWLCol              ; R0 := TWLCol; (R1 := TWBRow)
        LDMIA   R0, {R0-R3}                     ; R2 := TWRCol; R3 := TWTRow
        MOV     R1, R3                          ; R1 := TWTRow
        B       ClearBox

SoftScrollDown
        Push    R14
        TST     R6, #TeletextMode
        BNE     TTXSoftScrollDown

        BL      TryCopyWindowDown
        Pull    R14, EQ
        BEQ     ClearTopLine
        BL      GetWindowInfo

;       R2 = address of top left
;       R5 = number of bytes horizontally
;       R6 = number of pixel rows in box
;       R7 = linelength
;       R8 = number of character rows in box

        ADD     R0, WsPtr, #TWLCol              ; R0 := TWLCol; R1 := TWBRow
        LDMIA   R0, {R0-R1}
        BL      AddressR0R1             ; R2 -> top line of bottom left char

        LDR     R0, [WsPtr, #RowMult]
        BL      SoftScrollDown2
        Pull    R14
        B       ClearTopLine

; *****************************************************************************
;
;       SoftScrollDown2 - Called by SoftScrollDown and by TTX to scroll map
;
; in:   R0 = RowMult
;       R2 = screen address of top line of bottom left char
;       R5 = number of bytes horizontally
;       R6 = number of pixel rows vertically
;       R7 = linelength
;

SoftScrollDown2 ROUT
        SUBS    R6, R6, R0              ; scroll number of rows-1
        MOVEQ   PC, R14                 ; single row window, nowt to scroll

        SUB     R2, R2, R7              ; R2 -> bottom line of next-to-bottom
        LDR     R1, [WsPtr, #RowLength]
        ADD     R2, R2, R1              ; R2 -> bottom line of bottom

ScrollLineDown
        MOV     R1, R2
        LDR     R3, [WsPtr, #RowLength]
        SUB     R0, R1, R3              ; R0 -> line above,needs fudging
        ADD     R3, R2, R5              ; R3 -> byte after last one on upper
10
        CMP     R1, R3
        BEQ     %FT40                   ; finished
        TST     R1, #3
        LDRNEB  R8, [R0], #1
        STRNEB  R8, [R1], #1
        BNE     %BT10

        SUB     R4, R3, R1              ; number of bytes left on this line
        MOVS    R4, R4, LSR #4          ; number of 4-words left on this line
        SUBS    R4, R4, #1              ; C=0 if 0, C=1 if >0
14
        LDMHIIA R0!, {R8-R11}           ; this code dropped thru if was 0
        STMHIIA R1!, {R8-R11}
        LDMCSIA R0!, {R8-R11}
        STMCSIA R1!, {R8-R11}
        SUBCSS  R4, R4, #2
        BCS     %BT14

        BIC     R4, R3, #3
20
        CMP     R1, R4
        LDRNE   R8, [R0], #4
        STRNE   R8, [R1], #4
        BNE     %BT20

30
        CMP     R1, R3
        LDRNEB  R8, [R0], #1
        STRNEB  R8, [R1], #1
        BNE     %BT30

40
        SUB     R2, R2, R7
        SUBS    R6, R6, #1
        BNE     ScrollLineDown

        MOV     PC, R14

; *****************************************************************************
;
;       SetVinit       - Program Vinit with address in R0
;       SetVstart      - Program Vstart with address in R0
;       SetVendDefault - Program Vend with end address for TotalScreenSize
;
; out:  R0-R2 corrupted
;

; mjs Oct 2000 kernel/HAL split
; these routines now call GraphicsV_SetDMAAddress

; Note that the addresses provided are logical addresses for the software mapping
; of the display, and this starts at (ScreenEndAddr - TotalScreenSize) for
; wonderful historical reasons (h/w scroll, two mappings, blah, blah) - see eg. PRM 1-354
;
; To get physical address for the HAL, we subtract this software mapping start
; address and add the physical address of the start of video memory.
;

SetVstart
        LDR     r2, [WsPtr, #ScreenEndAddr]
        SUB     r1, r0, r2
        LDR     r2, [WsPtr, #TotalScreenSize]
        ADD     r1, r1, r2                      ; now we have offset of Vstart in video RAM
        LDR     r2, [WsPtr, #TrueVideoPhysAddr]
        ADD     r1, r1, r2                      ; now we have physical address of Vstart
        MOV     r0, #GVDAG_VStart
        B       Do_GVDAG

SetVendDefault
        LDR     r2, [WsPtr, #TrueVideoPhysAddr]
        LDR     r1, [WsPtr, #TotalScreenSize]
        ADD     r1, r1, r2                      ; physical address of Vend
        MOV     r0, #GVDAG_VEnd
        B       Do_GVDAG

SetDisplayScreenStart
        Push    "r0-r2,lr"
        BL      SetVrender
        Pull    "r0-r2,pc"

SetVrender
        STR     r0, [WsPtr, #DisplayScreenStart]
        LDR     r2, [WsPtr, #ScreenEndAddr]
        SUB     r1, r0, r2
        LDR     r2, [WsPtr, #TotalScreenSize]
        ADD     r1, r1, r2                      ; now we have offset of Vrender in video RAM
        LDR     r0, [WsPtr, #TeletextOffset]
        ADD     r1, r1, r0                      ; add on teletext bank offset
        CMP     r1, r2                          ; if out of range
        SUBCS   r1, r1, r2                      ; then subtract total size
        LDR     r2, [WsPtr, #TrueVideoPhysAddr] ; now we have physical address
        ADD     r1, r1, r2
        MOV     r0, #GVDAG_VRender
        B       Do_GVDAG

SetVinit
        STR     r0, [WsPtr, #DisplayStart]
        LDR     r2, [WsPtr, #ScreenEndAddr]
        SUB     r1, r0, r2
        LDR     r2, [WsPtr, #TotalScreenSize]
        ADD     r1, r1, r2                      ; now we have offset of Vinit in video RAM
        LDR     r0, [WsPtr, #TeletextOffset]
        ADD     r1, r1, r0                      ; add on teletext bank offset
        CMP     r1, r2                          ; if out of range
        SUBCS   r1, r1, r2                      ; then subtract total size
        LDR     r2, [WsPtr, #TrueVideoPhysAddr] ; now we have physical address
        ADD     r1, r1, r2
        MOV     r0, #GVDAG_VInit
Do_GVDAG
        Push    "r4, lr"
        LDR     r4, [WsPtr, #CurrentGraphicsVDriver]
        MOV     r4, r4, LSL #24
        ORR     r4, r4, #GraphicsV_SetDMAAddress
        BL      CallGraphicsV
        Pull    "r4, pc"

; *****************************************************************************
;
;       ConvertBankToAddress - Convert bank number into default start address
;
; in:   R2 = screen bank number (0..n)
;
; out:  R3 = default start address for that bank
;       R0-R2 preserved
;       R4,R5 corrupted
;

ConvertBankToAddress ROUT
        MOV     R4, R2
        LDR     R3, [WsPtr, #TotalScreenSize]
        LDR     R5, [WsPtr, #ScreenEndAddr]
        RSB     R3, R3, R5                      ; R3 := start of all screen mem
        LDR     R5, [WsPtr, #ScreenSize]
10
        MOVS    R4, R4, LSR #1                  ; add on R4*ScreenSize
        ADDCS   R3, R3, R5
        ADD     R5, R5, R5
        BNE     %BT10
        MOV     PC, R14

; *****************************************************************************
;
;       Delete - delete a character
;
; in:   R6 = CursorFlags
;

Delete  ROUT
        Push    R14

        TST     R6, #TEUpdate                   ; if colours dirty
        BLNE    ReallySetColours                ; then update them

        TST     R6, #32                         ; Bit 5 set => no cursor move
        BLEQ    BS
        LDR     R6, [WsPtr, #CursorFlags]       ; reload in case BS corrupts it

        TST     R6, #Vdu5Bit
        TSTEQ   R6, #(TeletextMode :OR: ClipBoxEnableBit)
        BNE     %FT20
10
        Pull    R14
        MOV     tophalf, #0                     ; Print with space
        MOV     bottomhalf, #0
        LDR     screen, [WsPtr, #CursorAddr]
        LDR     bigfont, [WsPtr, #TextExpandArea]
        LDR     linelen, [WsPtr, #LineLength]
        LDR     PC, [WsPtr, #WrchNbit]

20
        TST     R6, #Vdu5Bit
        Pull    R14, NE
        BNE     Vdu5Delete

        TST     R6, #TeletextMode
        MOVNE   R0, #32                         ; wipe out with space
        Pull    R14, NE
        BNE     TTXDoChar

        BL      ClipCursorCell                  ; must be ClipBoxEnable
        B       %BT10                           ; so clip cursor and continue

      [ {FALSE}

; *****************************************************************************
;
;       Convert colours if in 256 colour mode
;
; in:   bpp = BitsPerPix
;       fore = foreground colour (in 'user' format)
;       back = background colour (-------""-------)
;
; out:  fore, back = adjusted colours (if necessary)

ConvertCol
        CMP     bpp, #8
        MOVNE   PC, R14

        Push    R14
        MOV     col, fore
        LDR     index, [WsPtr, #TFTint]
        BL      FudgeColour
        MOV     fore, col

        MOV     col, back
        LDR     index, [WsPtr, #TBTint]
        BL      FudgeColour
        MOV     back, col

        Pull    PC

FudgeColour                             ; col   =   0  0 B3 B2 G3 G2 R3 R2
                                        ; index =  t1 t0  0  0  0  0  0  0

        MOV     R3, col, LSL #2         ; R3 :=  B3 B2 G3 G2 R3 R2  0  0
        AND     R3, R3, #&84            ; R3 :=  B3  0  0  0  0 R2  0  0
        MOVS    col, col, LSL #28       ; C :=   B2
        MOV     col, col, LSR #29       ; col :=  0  0  0  0  0 G3 G2 R3
        ORR     col, R3, col, LSL #4    ; col := B3 G3 G2 R3  0 R2  0  0
        ORRCS   col, col, #&08          ; col := B3 G3 G2 R3 B2 R2  0  0
        ORR     col, col, index, LSR #6 ; col := B3 G3 G2 R3 B2 R2 T1 T0
        MOV     PC, R14

      ]

; *****************************************************************************

PlainBit ROUT

; first set up RAMMaskTb

        ASSERT  bpp=0

        LDR     bpp, [WsPtr, #BytesPerChar]
        MOV     R1, #1
        RSB     R1, R1, R1, LSL bpp      ; first form mask for leftmost pixel
                                         ; = (2^BytesPerChar)-1

        ADD     R3, WsPtr, #RAMMaskTb
10
        STR     R1, [R3], #4            ; store mask
        MOVS    R1, R1, LSL bpp         ; shift to next pixel
        BNE     %BT10                   ; loop until all shifted out

; DDV: Original code used to read:
;
;       TEQ     bpp, #16
;       MOVEQ   PC, R14     ; nothing to do on a mode change in this mode
;
; In 32 bit per pixel modes this used to cause an overflow, new function
; drops out if the bpp >= 16.
;
        CMP     bpp, #16
        MOVGE   PC, R14     ; nothing to do on a mode change in this mode
        Push    R14

        LDR     tabaddr, [WsPtr, #TextExpandArea]
        ADD     tabaddr, tabaddr, bpp, LSL #8   ; TextPlain now dynamic

        MOV     dest, #&80000000

        CMP     bpp, #4
        BHI     Plain8Bit
        BEQ     Plain4Bit
        CMP     bpp, #1
        BHI     Plain2Bit

Plain1Bit
        ADR     hiaddr, P1BTab
        ADD     R10, hiaddr, #8                ; end address
P1B20
        LDR     hiword, [hiaddr], #4
P1B25
        ADR     loaddr, P1BTab
P1B30
        LDR     loword, [loaddr], #4
P1B40
        MOV     cbyte, hiword, LSL #28
        ORR     dest, cbyte, dest, LSR #4
        MOV     cbyte, loword, LSL #28
        ORRS    dest, cbyte, dest, LSR #4
        BLCS    OutputNoColour

        MOVS    loword, loword, LSR #4
        BNE     P1B40
        TEQ     loaddr, R10
        BNE     P1B30

        MOVS    hiword, hiword, LSR #4
        BNE     P1B25
        TEQ     hiaddr, R10
        BNE     P1B20

        Pull    PC

OutputColour
        AND     cbyte, dest, fore
        BIC     dest, back, dest
        ORR     dest, dest, cbyte
OutputNoColour
        STR     dest, [tabaddr], #4
        MOV     dest, #&80000000
        MOV     PC, R14

P1BTab
        &       &E6A2C480
        &       &F7B3D591

; *****************************************************************************

Plain2Bit
        ADR     hiaddr, P2BTab
        ADD     R10, hiaddr, #16
P2B20
        LDR     hiword, [hiaddr], #4
P2B25
        ADR     loaddr, P2BTab
P2B30
        LDR     loword, [loaddr], #4
P2B40
        MOV     cbyte, hiword, LSL #24
        ORR     dest, cbyte, dest, LSR #8
        MOV     cbyte, loword, LSL #24
        ORRS    dest, cbyte, dest, LSR #8
        BLCS    OutputNoColour

        MOVS    loword, loword, LSR #8
        BNE     P2B40
        TEQ     loaddr, R10
        BNE     P2B30

        MOVS    hiword, hiword, LSR #8
        BNE     P2B25
        TEQ     hiaddr, R10
        BNE     P2B20

        Pull    PC

P2BTab
        &       &F030C000
        &       &FC3CCC0C
        &       &F333C303
        &       &FF3FCF0F

; *****************************************************************************

Plain4Bit
        ADR     hiaddr, P4BTab
        ADD     R10, hiaddr, #32
P4B20
        LDR     hiword, [hiaddr], #4
P4B25
        ADR     loaddr, P4BTab
P4B30
        LDR     loword, [loaddr], #4
P4B40
        MOV     cbyte, hiword, LSL #16
        ORR     dest, cbyte, dest, LSR #16
        MOV     cbyte, loword, LSL #16
        ORRS    dest, cbyte, dest, LSR #16
        BLCS    OutputNoColour

        MOVS    loword, loword, LSR #16
        BNE     P4B40
        TEQ     loaddr, R10
        BNE     P4B30

        MOVS    hiword, hiword, LSR #16
        BNE     P4B25
        TEQ     hiaddr, R10
        BNE     P4B20

        Pull    PC

P4BTab
        &       &F0000000
        &       &FF000F00
        &       &F0F000F0
        &       &FFF00FF0
        &       &F00F000F
        &       &FF0F0F0F
        &       &F0FF00FF
        &       &FFFF0FFF

; *****************************************************************************

Plain8Bit
        ADR     hiaddr, P8BTab
        ADD     R10, hiaddr, #64
P8B20
        LDR     hiword, [hiaddr], #4
        ADR     loaddr, P8BTab
P8B30
        MOV     dest, hiword
        BL      OutputNoColour
        LDR     dest, [loaddr], #4
        BL      OutputNoColour

        TEQ     loaddr, R10
        BNE     P8B30

        TEQ     hiaddr, R10
        BNE     P8B20

        Pull    PC

P8BTab
        &       &00000000
        &       &FF000000
        &       &00FF0000
        &       &FFFF0000
        &       &0000FF00
        &       &FF00FF00
        &       &00FFFF00
        &       &FFFFFF00
        &       &000000FF
        &       &FF0000FF
        &       &00FF00FF
        &       &FFFF00FF
        &       &0000FFFF
        &       &FF00FFFF
        &       &00FFFFFF
        &       &FFFFFFFF

; *****************************************************************************
;
;       ReadCharacter - Read character at (input) text cursor position
;
; out:  R0 = character, 0 if unrecognised
;

ReadCharacter
        Push    R14

        BL      PreWrchCursor           ; remove both cursors
        BL      CheckTEUpdate           ; update TextExpand if necessary
                                        ; R6 = CursorFlags on exit
        TST     R6, #TeletextMode
        BNE     TTXReadCharacter

        TST     R6, #CursorsSplit
        LDREQ   R2, [WsPtr, #CursorAddr]        ; point to correct address
        LDRNE   R2, [WsPtr, #InputCursorAddr]

        LDR     R4, [WsPtr, #TextBgColour]
        LDR     R8, [WsPtr, #LineLength]

        LDR     R1, [WsPtr, #ModeFlags]
        TST     R1, #ModeFlag_DoubleVertical
        BNE     RdCh1BitDouble

        LDR     R1, [WsPtr, #CharWidth]
        CMP     R1, #2
        BCC     RdCh1Bit
        BEQ     RdCh2Bit
        CMP     R1, #8
        BCC     RdCh4Bit
        BEQ     RdCh8Bit

        CMP     R1, #16
        BEQ     RdCh16Bit

; Read character from cursor position for 32 bit per pixel

; in    R2 -> cursor address
;       R4 = background colour
;       R8 = line length to be used
;
; out   R6 = first four bytes of char defn
;       R7 = last four bytes of char defn

; used  R0,R1,R3,R5,R9,R10,R11,LR = loading screen data!

        MACRO
        ConvertTo1BPP $source, $dest, $bit
        EORS    $source, $source, R4
        ORRNE   $dest, $dest, #$bit
        MEND

RdChr32Bit
        Push    "R0-R1,R3,R5,R9,R10-R12"

        BL      RdCh32Bit_GetData
        MOV     R6,R7
        BL      RdCh32Bit_GetData

        Pull    "R0-R1,R3,R5,R9,R10-R12"
        B       RDCH14

; ***********************************************************************

RdCh32Bit_GetData
        MOV     R7, #1:SHL:31

RdCh32Bit_Loop
        MOVS    R7, R7, LSR #8

        LDMIA   R2,{R0,R1,R3,R5,R9,R10,R11,R12}
        ConvertTo1BPP R0,  R7, 1<<31
        ConvertTo1BPP R1,  R7, 1<<30
        ConvertTo1BPP R3,  R7, 1<<29
        ConvertTo1BPP R5,  R7, 1<<28
        ConvertTo1BPP R9,  R7, 1<<27
        ConvertTo1BPP R10, R7, 1<<26
        ConvertTo1BPP R11, R7, 1<<25
        ConvertTo1BPP R12, R7, 1<<24

        ADD     R2, R2, R8
        BCC     RdCh32Bit_Loop

        MOV     PC,LR

RdCh16Bit
        ADD     R2, R2, #12
        ADD     R5, R2, R8, LSL #2              ; half way
        ADD     R3, R2, R8, LSL #3              ; one-after-finishing R2
        ADD     R8, R8, #12
        MOV     R7, #0
RDCH90
        LDR     R1, [R2], #-4
        EOR     R1, R1, R4
        CMP     R1, #&00010000
        MOV     R7, R7, RRX
        MOV     R1, R1, LSL #16
        CMP     R1, #&00010000
        MOV     R7, R7, RRX

        LDR     R1, [R2], #-4
        EOR     R1, R1, R4
        CMP     R1, #&00010000
        MOV     R7, R7, RRX
        MOV     R1, R1, LSL #16
        CMP     R1, #&00010000
        MOV     R7, R7, RRX

        LDR     R1, [R2], #-4
        EOR     R1, R1, R4
        CMP     R1, #&00010000
        MOV     R7, R7, RRX
        MOV     R1, R1, LSL #16
        CMP     R1, #&00010000
        MOV     R7, R7, RRX

        LDR     R1, [R2], R8
        EOR     R1, R1, R4
        CMP     R1, #&00010000
        MOV     R7, R7, RRX
        MOV     R1, R1, LSL #16
        CMP     R1, #&00010000
        MOV     R7, R7, RRX

        TEQ     R2, R5                          ; half-way, so copy out word
        MOVEQ   R6, R7                          ; top word
        MOVEQ   R7, #0

        TEQ     R2, R3                          ; finished ?
        BNE     RDCH90
        BEQ     RDCH14


RdCh8Bit
        ADD     R2, R2, #4
        ADD     R5, R2, R8, LSL #2              ; half way
        ADD     R3, R2, R8, LSL #3              ; one-after-finishing R2
        MOV     R7, #0
        ADD     R8, R8, #4                      ; alternate between -4 and LL+4
        MVN     R9, R8
        EOR     R9, R9, #3                      ; thing to EOR R8 with
RDCH84
        EOR     R8, R8, R9
        LDR     R1, [R2], R8
        EOR     R1, R1, R4
        CMP     R1, #&01000000
        MOV     R7, R7, RRX
        MOV     R1, R1, LSL #8
        ORR     R1, R1, #1                      ; dummy bit
        CMP     R1, #&01000000
RDCH88
        MOV     R7, R7, RRX
        MOV     R1, R1, LSL #8
        CMP     R1, #&01000000                  ; Z => finish, C = output bit
        BNE     RDCH88

        TEQ     R2, R5                          ; half-way, so copy out word
        MOVEQ   R6, R7                          ; top word
        MOVEQ   R7, #0

        TEQ     R2, R3                          ; finished ?
        BNE     RDCH84
        BEQ     RDCH14


RdCh4Bit
        ADD     R5, R2, R8, LSL #2              ; half way
        ADD     R3, R2, R8, LSL #3              ; one-after-finishing R2
        MOV     R7, #0
RDCH44
        LDR     R1, [R2], R8
        EOR     R1, R1, R4
        CMP     R1, #&10000000
        MOV     R7, R7, RRX
        MOV     R1, R1, LSL #4
        ORR     R1, R1, #1                      ; dummy bit
        CMP     R1, #&10000000
RDCH48
        MOV     R7, R7, RRX
        MOV     R1, R1, LSL #4
        CMP     R1, #&10000000                  ; Z => finish, C = output bit
        BNE     RDCH48

        TEQ     R2, R5                          ; half-way, so copy out word
        MOVEQ   R6, R7                          ; top word
        MOVEQ   R7, #0

        TEQ     R2, R3                          ; finished ?
        BNE     RDCH44
        BEQ     RDCH14


RdCh2Bit
        ANDS    R0, R2, #3
        EOR     R2, R2, R0                      ; make R2 -> word boundary
        MOVNE   R0, #16                         ; shift adjust
        ADD     R5, R2, R8, LSL #2              ; half way
        ADD     R3, R2, R8, LSL #3              ; one-after-finishing R2
        MOV     R7, #0
RDCH24
        LDR     R1, [R2], R8
        EOR     R1, R1, R4
        MOV     R1, R1, ROR R0
        MOV     R1, R1, LSL #16                 ; important bits at top
        ORR     R1, R1, #&4000                  ; dummy bit
        CMP     R1, #&40000000
RDCH28
        MOV     R7, R7, RRX
        MOV     R1, R1, LSL #2
        CMP     R1, #&40000000                  ; Z => finish, C = output bit
        BNE     RDCH28

        TEQ     R2, R5                          ; half-way, so copy out word
        MOVEQ   R6, R7                          ; top word
        MOVEQ   R7, #0

        TEQ     R2, R3                          ; finished ?
        BNE     RDCH24
        BEQ     RDCH14

RdCh1Bit
        LDRB    R6, [R2], R8
        MOV     R6, R6, LSL #24
        LDRB    R0, [R2], R8
        ORR     R6, R6, R0, LSL #16
        LDRB    R0, [R2], R8
        ORR     R6, R6, R0, LSL #8
        LDRB    R0, [R2], R8
        ORR     R0, R6, R0
        EOR     R0, R0, R4                      ; make background zero

        MOV     R6, #1                          ; now invert order of bits
RDCH10
        MOVS    R0, R0, LSR #1
        ADCS    R6, R6, R6
        BCC     RDCH10

        LDRB    R7, [R2], R8
        MOV     R7, R7, LSL #24
        LDRB    R0, [R2], R8
        ORR     R7, R7, R0, LSL #16
        LDRB    R0, [R2], R8
        ORR     R7, R7, R0, LSL #8
        LDRB    R0, [R2], R8
        ORR     R0, R7, R0
        EOR     R0, R0, R4

        MOV     R7, #1                          ; now invert order of bits
RDCH12
        MOVS    R0, R0, LSR #1
        ADCS    R7, R7, R7
        BCC     RDCH12

RDCH14
        MOV     R0, #32
        ADD     R1, WsPtr, # Font
RDCH16
        LDMIA   R1!, {R2,R3}
        TEQ     R2, R6
        TEQEQ   R3, R7
        BEQ     RDCH17                          ; successful match
        ADD     R0, R0, #1
        TEQ     R0, #127
        ADDEQ   R0, R0, #1
        ADDEQ   R1, R1, #8
        ANDS    R0, R0, #&FF                    ; 0 if finished
        BNE     RDCH16

RDCH17
        Push    R0                              ; save char
        BL      PostWrchCursor
        Pull    "R0, PC"

; *****************************************************************************

RdCh1BitDouble                                  ; double height mode
        LDRB    R0, [R2], R8
        LDRB    R3, [R2], R8
        TEQ     R0, R3
        MOVEQ   R6, R0, LSL #24
        LDREQB  R0, [R2], R8
        LDREQB  R3, [R2], R8
        TEQEQ   R0, R3
        ORREQ   R6, R6, R0, LSL #16
        LDREQB  R0, [R2], R8
        LDREQB  R3, [R2], R8
        TEQEQ   R0, R3
        ORREQ   R6, R6, R0, LSL #8
        LDREQB  R0, [R2], R8
        LDREQB  R3, [R2], R8
        TEQEQ   R0, R3
        ORREQ   R0, R6, R0

        MOVNE   R0, #0                          ; indicate bad character
        BNE     RDCH17                          ; and branch

        EOR     R0, R0, R4                      ; make background zero

        MOV     R6, #1                          ; now invert order of bits
RDCH10D
        MOVS    R0, R0, LSR #1
        ADCS    R6, R6, R6
        BCC     RDCH10D

        LDRB    R0, [R2], R8
        LDRB    R3, [R2], R8
        TEQ     R0, R3
        MOVEQ   R7, R0, LSL #24
        LDREQB  R0, [R2], R8
        LDREQB  R3, [R2], R8
        TEQEQ   R0, R3
        ORREQ   R7, R7, R0, LSL #16
        LDREQB  R0, [R2], R8
        LDREQB  R3, [R2], R8
        TEQEQ   R0, R3
        ORREQ   R7, R7, R0, LSL #8
        LDREQB  R0, [R2], R8
        LDREQB  R3, [R2], R8
        TEQEQ   R0, R3
        ORREQ   R0, R7, R0

        MOVNE   R0, #0                          ; indicate bad character
        BNE     RDCH17                          ; and branch

        EOR     R0, R0, R4

        MOV     R7, #1                          ; now invert order of bits
RDCH12D
        MOVS    R0, R0, LSR #1
        ADCS    R7, R7, R7
        BCC     RDCH12D
        B       RDCH14

; *****************************************************************************

TTXReadCharacter
        TST     R6, #CursorsSplit
        LDR     R1, [WsPtr, #TTXLineStartsPtr]
        LDREQ   R2, [WsPtr, #CursorY]
        LDRNE   R2, [WsPtr, #InputCursorY]
        LDR     R1, [R1, R2, LSL #2]
        LDREQ   R2, [WsPtr, #CursorX]
        LDRNE   R2, [WsPtr, #InputCursorX]
        ADD     R2, R2, #1                      ; skip dummy
        LDRB    R1, [R1, R2, LSL #2]
        MOV     R0, R1
        TEQ     R1, #"#"                        ; not those again !
        MOVEQ   R0, #"`"
        TEQ     R1, #"`"
        MOVEQ   R0, #"_"
        TEQ     R1, #"_"
        MOVEQ   R0, #"#"
        B       RDCH17

; *****************************************************************************
;
;       DoOSBYTE87 - OSBYTE &87 entry point
;
; in:   -
;
; out:  R0 = &87
;       R1 = character at text cursor, 0 if unrecognised
;       R2 = screen mode
;

DoOSBYTE87
        Push    "R3-R11,R14"
        BL      ReadCharacter
        MOV     R1, R0
        MOV     R0, #&87
        LDR     R2, [WsPtr, #ModeNo]
        CMP     R0, #0                          ; clear V for any wallies!
        Pull    "R3-R11,PC"

; *****************************************************************************
;
;       PageTest - check for CTRL/SHIFT, page mode
;
; in:   R6 = CursorFlags
;

PageTest
        Push    R14

        BL      Page_ProcessCallbacks   ; give callbacks at least one chance per line

        CLC                             ; don't set leds first time
        BL      CtrlShiftTest           ; on exit, C=CTRL, N=SHIFT
        BCC     Page20                  ; CTRL up, then branch
        BPL     Page20                  ; SHIFT up, then branch

; CTRL and SHIFT are down

        BL      ClearLines              ; CTRL+SHIFT down, so clear lines
        BL      PostWrchCursor          ; we may be some time, so enable cursor
CSWaitLoop
        SEC                             ; set leds
        BL      CtrlShiftTest
        BCC     Page18
        BLMI    Page_ProcessCallbacksIdle
        BMI     CSWaitLoop              ; and wait for change (NB C=1 now)
Page18
 [ {FALSE}
        BL      LEDsOff                 ; put LEDs back to normal
 ]
        BL      PreWrchCursor           ; get rid of cursor again

; CTRL and SHIFT are not both down

Page20
        CLC                             ; don't set leds first time
        BL      CtrlShiftTest
        BCC     Page40                  ; [CTRL not down]

; CTRL down, so wait for auto repeat delay time before continuing

        BL      PostWrchCursor          ; we may be some time, so enable cursor

        LDROSB  R1, KeyRepRate
        STROSB  R1, CentiCounter, R0
        CLC
Page30
        BL      CtrlShiftTest
        BCC     Page35                  ; CTRL no longer down
        LDROSB  R1, CentiCounter
        CMP     R1, #1
        BLCS    Page_ProcessCallbacksIdle
        BCS     Page30                  ; loop with carry set
Page35
        BL      PreWrchCursor           ; remove cursor again

; CTRL not down, test for page mode

Page40
; If we're using the debug terminal, never use paged mode, because serial input doesn't work too well when you need to detect shift being pressed!
 [ :LNOT: DebugTerminal
        EOR     R0, R6, #PageMode
        TST     R0, #(PageMode :OR: CursorsSplit)
        Pull    PC, NE                  ; cursors split or not in page mode

        LDROSB  R3, PageModeLineCount
        BL      BotRowCheck             ; are we on bottom row ?
        BNE     IncLinesExit
        TST     R6, #8
        LDREQ   R0, [WsPtr, #TWBRow]
        LDREQ   R1, [WsPtr, #TWTRow]
        LDRNE   R0, [WsPtr, #TWRCol]
        LDRNE   R1, [WsPtr, #TWLCol]
        SUB     R0, R0, R1              ; get number of lines in window
        SUB     R0, R0, R0, LSR #2      ; * 3/4 (rounded up)
        CMP     R0, R3                  ; does PageModeLineCount exceed this ?
        BCC     Page50                  ; yes, then wait until SHIFT up
IncLinesExit
        ADD     R3, R3, #1
        STROSB  R3, PageModeLineCount, R0
 ]
        Pull    PC

Page50                                  ; NB C=0 on entry from above
        BL      CtrlShiftTest
        BMI     Page55

; Waiting for shift

        BL      PostWrchCursor          ; put cursor back on for now
PageWaitLoop
        SEC
        BL      CtrlShiftTest
        BLPL    Page_ProcessCallbacksIdle
        BPL     PageWaitLoop
        BL      PreWrchCursor

Page55
        Pull    R14
ClearLines
        MOV     R0, #1                  ; fudge for MASTER compatibility
        STROSB  R0, PageModeLineCount, R1
        MOV     PC, R14

BotRowCheck
        TST     R6, #2
        LDREQ   R1, [WsPtr, #TWRCol]
        LDRNE   R1, [WsPtr, #TWLCol]
        TST     R6, #4
        LDREQ   R0, [WsPtr, #TWBRow]
        LDRNE   R0, [WsPtr, #TWTRow]
        TST     R6, #8
        EORNE   R0, R0, R1              ; swap R0, R1
        EORNE   R1, R0, R1
        EORNE   R0, R0, R1
        LDREQ   R2, [WsPtr, #CursorY]
        LDRNE   R2, [WsPtr, #CursorX]
        TEQ     R0, R2
        MOV     PC, R14

CtrlShiftTest ROUT
        BCC     %FT05
 [ {FALSE}
        Push    R14
        BL      LEDsOn
        Pull    R14
 ]
05      LDR     R0, =ZeroPage
        LDRB    R0, [R0, #ESC_Status]
        TST     R0, #&40                ; escape condition ?
        LDROSB  R0, KeyBdStatus         ; (preserves PSR)
        BEQ     %FT10                   ; [no escape]

        Push    R14
        BIC     R0, R0, #KBStat_ScrollLock ; escape, so cancel scroll lock
        STROSB  R0, KeyBdStatus, R14    ; and store back
        MOV     R0, #&20                ; pretend shift down, ctrl up
        MOVS    R0, R0, LSL #(32-6)     ; C=CTRL, N=SHIFT
        Pull    PC

10
        TST     R0, #&08                ; shift bit
        ORRNE   R0, R0, #&20            ; move it to bit below ctrl (bit 6)
        BICEQ   R0, R0, #&20
        TST     R0, #KBStat_ScrollLock  ; if scroll lock on
        ORRNE   R0, R0, #&60            ; then pretend ctrl and shift down
        MOVS    R0, R0, LSL #(32-6)     ; C=CTRL, N=SHIFT
        MOV     PC, R14

Page_ProcessCallbacks
        Entry
        ; See if there are any pending callbacks
        LDR     R0, =ZeroPage
        LDRB    R14, [R0, #CallBack_Flag]
        TST     R14, #CBack_VectorReq
        BLNE    process_callback_chain
        EXIT

Page_ProcessCallbacksIdle
        EntryS                          ; routine must preserve flags
        ; See if there are any pending callbacks
        LDR     R0, =ZeroPage
        LDRB    R14, [R0, #CallBack_Flag]
        TST     R14, #CBack_VectorReq
        BLNE    process_callback_chain
        ; Now they're dealt with, we have nothing else to do, so call Idle
        LDRB    R14, [r0, #PortableFlags]
        TST     R14, #PortableFeature_Idle
        SWINE   XPortable_Idle
        EXITS

; *****************************************************************************
;
;       SO - Page mode on
;
; in:   R6 = CursorFlags
;

SO
        LDR     R0, =ZeroPage
        ASSERT  (ZeroPage :AND: 255) = 0
        STRB    R0, [R0, #OsbyteVars + :INDEX: PageModeLineCount]

        ORR     R6, R6, #PageMode
        STR     R6, [WsPtr, #CursorFlags]

        MOV     PC, R14

; *****************************************************************************
;
;       SI - Page mode off
;
; in:   R6 = CursorFlags
;

SI
        BIC     R6, R6, #PageMode
        STR     R6, [WsPtr, #CursorFlags]

        MOV     PC, R14

; *****************************************************************************
;
;       DoResetFont - Reset some or all of the soft font from the hard font
;
; in:   R1*32 = start character, R2 = number of pages to copy
;
;       NB no range checking is done on these numbers

DoResetFont     ROUT

        ADRL    R0, HardFont-32*8
        ADD     R3, WsPtr, #(Font-32*8)

        ADD     R0, R0, R1, LSL #8      ; start source
        ADD     R3, R3, R1, LSL #8      ; start dest
        ADD     R1, R0, R2, LSL #8      ; end source

10
        LDR     R2, [R0], #4
        STR     R2, [R3], #4
        TEQ     R0, R1
        BNE     %BT10

        MOV     PC, R14

; *****************************************************************************
;
;       DoReadFont - Read character font
;
; in:   R1 -> control block
;       [R1, #0] = character to read (2..5 => read ecf, 6=> read dotdash)
;
; out:  [R1, #1..8] = font for that character
;

DoReadFont
        LDRB    R0, [R1]
        CMP     R0, #32
        ADD     R0, WsPtr, R0, LSL #3
        ADDCS   R0, R0, #(Font-32*8)           ; R0 -> font
        ADDCC   R0, R0, #(Ecf1-2*8)
        LDMIA   R0, {R2,R3}

      [ NoARMv6 :LOR: NoUnaligned
        STRB    R2, [R1, #1]
        MOV     R2, R2, LSR #8
        STRB    R2, [R1, #2]
        MOV     R2, R2, LSR #8
        STRB    R2, [R1, #3]
        MOV     R2, R2, LSR #8
        STRB    R2, [R1, #4]

        STRB    R3, [R1, #5]
        MOV     R3, R3, LSR #8
        STRB    R3, [R1, #6]
        MOV     R3, R3, LSR #8
        STRB    R3, [R1, #7]
        MOV     R3, R3, LSR #8
        STRB    R3, [R1, #8]
      |
        ; Use unaligned store from ARMv6
        STR     R2, [R1], #4
        STR     R3, [R1]
      ]

        MOV     PC, R14

; *****************************************************************************
;
;       NAK - Disable VDU
;
; in:   R6 = CursorFlags
;

NAK
        ORR     R6, R6, #VduDisabled
        STR     R6, [WsPtr, #CursorFlags]
        MOV     PC, R14

; *****************************************************************************
;
;       STX - Turn printer on
;       ETX - Turn printer off
;
; in:   R0 = 2 or 3
;

STX
ETX

; insert code here to call UPTVEC or NETVEC
; (probably need to restore cursor while doing so in case of 'Not listening')

        LDR     R1, [WsPtr, #VduStatus]
        TEQ     R0, #2                          ; turning on ?
        ORREQ   R1, R1, #Vdu2Mode               ; yes, then set bit
        BICNE   R1, R1, #Vdu2Mode               ; no, then clear bit
        STR     R1, [WsPtr, #VduStatus]
        MOVEQ   PC, R14                         ; exit if not turning off

        Push    R14
        MOV     R0, #&7B                        ; make printer dormant
        SWI     XOS_Byte
        Pull    PC, VC

; bad exit from the OSBYTE

        Pull    R14
        B       VduBadExit

; *****************************************************************************
;
;       BEL - Do VDU 7
;
; in:   BELLchannel, BELLinfo, BELLfreq, BELLdur contain info for bell
;       BELLinfo:       Bits 0,1        S bits
;                       Bit  2          H bit
;                       Bits 3-6        (envelope-1) OR (volume+15)
;                       Bit  7          0 => envelope, 1 => volume
;
; out:  SOUND &HFSC, A, P, D
;

BEL     ROUT
        Push    R14
        BYTEWS  R0
        ADD     R1, WsPtr, #(BeepBlock :AND: &FF)
        ADD     R1, R1, #(BeepBlock :AND: &FF00)

        MOV     R2, #0
        STRB    R2, [R1, #5]                    ; zero hi-byte of pitch
        STRB    R2, [R1, #7]                    ; zero hi-byte of duration

        LDRB    R2, [R0, #:INDEX: BELLchannel]  ; copy channel
        STRB    R2, [R1, #0]                    ; into OSWORD block

        LDRB    R2, [R0, #:INDEX: BELLinfo]     ; get info
        AND     R3, R2, #7                      ; bit 2 of R3 is H, bits 0,1=S
        TST     R3, #4
        EORNE   R3, R3, #(4 :EOR: &10)          ; put H into bit 4
        STRB    R3, [R1, #1]                    ; store H and S

        MOV     R2, R2, LSL #24
        MOV     R2, R2, ASR #(24+3)             ; shift down, sign extending
        ADD     R2, R2, #1
        STRB    R2, [R1, #2]                    ; store lo-byte of env/vol
        MOV     R2, R2, LSR #8
        STRB    R2, [R1, #3]                    ; store hi-byte of env/vol

        LDRB    R2, [R0, #:INDEX: BELLfreq]
        STRB    R2, [R1, #4]                    ; copy pitch

        LDRB    R2, [R0, #:INDEX: BELLdur]
        STRB    R2, [R1, #6]                    ; copy duration

        MOV     R0, #7                          ; OSWORD SOUND
        SWI     XOS_Word
        Pull    PC

; *****************************************************************************

; Compile the text fg / bg (and tint info if required) into a sensible set of
; colour words.

; The routines take the TextFg and TextBg colours, if NColour >= 63 then
; we attempt to combine the tint information, this is then passed onto
; ColourTrans to force the colour change.

; in    -
; out   [TextFgColour] / [TextBgColour] updated to contain new values

; amg: 30/11/93 split these into separate routines to sort out a problem.
; When OS_SetColour was being used for text colours in >=8bpp TForeCol/TBackCol
; and TForeTint/TBackTint went out of step. Thus when a VDU 17 or VDU 23,17,0 | 1
; came along both fore and back text colours were getting changed. This solution
; is not perfect, since doing a TINT command before a colour change will still
; go wrong but I consider that worth leaving against the alternative of changing
; the function of this area of the code by having some magic value.

CompileTextBg ROUT

        Entry   "R0-R1"

        LDR     R1, [WsPtr, #NColour]
        CMP     R1, #63                         ; is this a daft mode?

        LDR     R0, [WsPtr, #TBackCol]
        LDRCS   LR, [WsPtr, #TBTint]
        ANDCS   LR, LR, #&C0                    ; only look at 2 bits of tint
        ORRCS   R0, R0, LR                      ; combine tint value to bg colour
        BLCS    ConvertGCOLToColourNumber
        STRVC   R0, [WsPtr, #TextBgColour]

        EXIT

CompileTextFg   ROUT

        Entry   "R0-R1"

        LDR     R1, [WsPtr, #NColour]
        CMP     R1, #63                         ; is this a daft mode?

        LDR     R0, [WsPtr, #TForeCol]
        LDRCS   LR, [WsPtr, #TFTint]
        ANDCS   LR, LR, #&C0                    ; only look at 2 bits of tint
        ORRCS   R0, R0, LR                      ; combine in the tint value
        BLCS    ConvertGCOLToColourNumber       ; convert colour using ColourTrans
        STRVC   R0, [WsPtr, #TextFgColour]      ;   store the value away - assume it worked!?!@?

        EXIT


; *****************************************************************************
;
; Convert a GCOL including Tint information to a physical colour, returning
; the colour number.  This is used for backwards compatibility with the
; existing 8 bit interfaces providided within the kernel.
;
; in    R0 = GCOL ( + tint ) := t t b b g g r r
; out   R0 = colour number (at current depth)
;       V set if no ColourTrans module.

; don't call CTrans if in 8bpp since otherwise GCOL numbers vary with
; palette changes!

ConvertGCOLToColourNumber ROUT

        EntryS  "R1-R2"

        LDR     R1, [WsPtr, #NColour]
        CMP     R1, #63
        CMPNE   R1, #255
        BEQ     %FT20

        AND     LR, R0, #4_3000                 ; extract the tint information
        MOV     R0, R0, LSL #14                 ; convert to a sensible bit location
        AND     R2, R0, #4_0003 :SHL: 14        ; extract the red
        ORR     R2, R2, LR, LSL #6              ; and then combine the tint information
        AND     R1, R0, #4_0030 :SHL: 14        ; extract the green
        ORR     R2, R2, R1, LSL #6
        ORR     R2, R2, LR, LSL #14             ; and combine with tint and green
        AND     R1, R0, #4_0300 :SHL: 14        ; finally extract the blue component
        ORR     R2, R2, R1, LSL #12
        ORR     R2, R2, LR, LSL #22             ; combine in the tint and blue
        ORR     R0, R2, R2, LSR #4              ; ensure physcial colour yields pure-white!

        SWI     XColourTrans_ReturnColourNumber

        EXITS
20
        MOV     r1, r0, LSR #6                  ; r1 =   0  0  0  0  0  0 T1 T0
        AND     r2, r0, #2_00100001             ; r2 =   0  0 B3  0  0  0  0 R2
        ORR     r1, r1, r2, LSL #2              ; r1 =  B3  0  0  0  0 R2 T1 T0
        AND     r2, r0, #2_00010000             ; r2 =   0  0  0 B2  0  0  0  0
        ORR     r1, r1, r2, LSR #1              ; r1 =  B3  0  0  0 B2 R2 T1 T0
        AND     r2, r0, #2_00001110             ; r2 =   0  0  0  0 G3 G2 R3  0
        ORR     r0, r1, r2, LSL #3              ; r0 =  B3 G3 G2 R3 B2 R2 T1 T0
        EXITS

        LTORG

        END