Commit aa42075c authored by Charles Ferguson's avatar Charles Ferguson
Browse files

Improved handling of colours; reclaim font on redirect and mode change.

parent 053d8fbc
In -
Out WRCHFont
Type Module
Ver 1.00d
Ver 1.00f
Pre
TYPE_GCOL=&FE
TYPE_PALETTE=&FF
End Pre
Define Workspace
Name module
......@@ -11,6 +16,7 @@ Define Workspace
`blk %2 for character and 0
=`fg ! foreground col
`bg ! background col
`xeig ! xeigen value
End Workspace
Define Module
......@@ -18,36 +24,27 @@ Define Module
Author Justin Fletcher
Vectors
WrchV wrchv
ColourV colourv
End Vectors
Workspace *`len_module
Init init
Final final
SWIs
Prefix WRCH
Base &700
0 Plot plot
End SWIs
Commands
Name WRCHCols
Code showcols
End Commands
Services
SwitchingOutputToSprite switchtosprite
PostModeChange postmodechange
End Services
End Module
>showcols
STMFD (sp)!,{r0-r5,link} ; Stack registers
LDR r12,[r12] ; read r12
LDRW r0,`fg ; read fg
LDRW r1,`bg ; read bg
REM "fg=%r0, bg=%r1"
LDMFD (sp)!,{r0-r5,pc} ; Return from call
.`fontname
EQUZA "Corpus.Bold"
>init
STMFD (sp)!,{r0-r5,link} ; Stack registers
XSWI "XFont_FindFont",,^$`name,16*12,16*14,0,0
XSWI "XOS_ReadModeVariable",-1,4 ; read xeig
STRW r2,`xeig ; store it
XSWI "XFont_FindFont",,^`fontname,16*12,16*14,0,0
STRWVC r0,`font ; if no error, store handle
XLDMFD (sp)!,{r0-r5,pc} ; Return from call
$`name
EQUZA "Corpus.Bold"
>final
STMFD (sp)!,{r0-r5,link} ; Stack registers
......@@ -55,10 +52,43 @@ $`name
XSWI "XFont_LoseFont" ; lose it
LDMFD (sp)!,{r0-r5,pc} ; Return from call
>plot
STMFD (sp)!,{link} ; extra link register for luck
BL wrchv ; jump to wrchv
LDMFD (sp)!,{pc} ; return back if they are ignoring
>postmodechange
STMFD (sp)!,{r0-r5,link} ; Stack registers
XSWI "XOS_ReadModeVariable",-1,4 ; read xeig
STRW r2,`xeig ; store it
LDRW r0,`font ; read handle
XSWI "XFont_LoseFont" ; lose it
XSWI "XFont_FindFont",,^`fontname,16*12,16*14,0,0
STRW r0,`font ; if no error, store handle
LDMFD (sp)!,{r0-r5,pc}^ ; Return from call
>switchtosprite
STMFD (sp)!,{r0-r7,link} ; Stack registers
LDRW r7,`lock ; read the (old) lock
TEQ r7,#0 ; is it 'ok' ?
BNE $exit ; if not, ignore this !
; REM "%c04%c30Switching to %r1"
MOV r5,#1 ; make a lock
STRW r5,`lock ; store the lock
; read xeig variable for this sprite
CMP r3,#0 ; or 0 (screen) ?
MVNEQ r0,#NOT -1 ; yes, r0=mode number
BEQ $isscreen ; yep, so we know the mode !
BIC r0,r2,#&FF ; leave just the access type
ORR r0,r0,#40 ; add 40 (Read Info)
XSWI "XOS_SpriteOp",,r3,r4 ; find out it's details
MOV r0,r6 ; r0=mode
$isscreen
XSWI "XOS_ReadModeVariable",,4 ; read xeig
STRW r2,`xeig ; store it
; now get the right font for it
LDRW r0,`font ; read handle
XSWI "XFont_LoseFont" ; lose it
XSWI "XFont_FindFont",,^`fontname,16*12,16*14,0,0
STRW r0,`font ; if no error, store handle
STRW r7,`lock ; zero the lock
$exit
LDMFD (sp)!,{r0-r7,pc}^ ; Return from call
>wrchv
STMFD (sp)!,{r0-r6,link} ; Stack registers
......@@ -67,7 +97,7 @@ $`name
BNE $notours ; nope, exit !
MOV r4,r0 ; r0=character
CMP r0,#32 ; is it 'ctrl' ?
BLT $notours ; yep, so it's not ours
BLE $notours ; yep, so it's not ours
TEQ r0,#127 ; or delete ?
BLT $notours ; yep, so again jump out
XSWI "XOS_Byte",117 ; read VDU status
......@@ -84,16 +114,45 @@ $`name
MOV r0,#1 ; make a lock
STRW r0,`lock ; store as lock
STRBW r4,`blk ; store character in block
; find a colour
ADRW r1,`fg ; block for col results
XSWI "XOS_ReadVduVariables",^$`vars
; read font handle
LDRW r0,`font ; read font to use
; now read internal stuff
MOV r6,#&1000 ; based 'somewhere in zeropage'
LDRW r2,`fg ; bg col
LDRW r1,`bg ; fg col
XSWI "XFont_SetFontColours",,,,0 ; select them
LDR r0,[r6,#&48] ; fg col
CMN r0,#1 ; is fg -1 ? (colourtrans)
LDRWEQ r4,`fg ; if so, read the colour
BEQ $fgnotcol ; and skip this code
XSWI "XOS_ReadPalette",,16 ; if not, read the palette entry
ORR r4,r2,#TYPE_PALETTE ; make into palette value
$fgnotcol
LDR r0,[r6,#&4C] ; bg col
CMN r0,#1 ; is bg -1 ? (colourtrans)
LDRWEQ r3,`bg ; if so, read the bg
BEQ $bgnotcol ; and skip this code
XSWI "XOS_ReadPalette",,16 ; if not, read the palette entry
ORR r3,r2,#TYPE_PALETTE ; make into palette value
$bgnotcol
; check fg (r4=fg, r5=bg)
AND r14,r4,#&FF ; read the 'type' of colour
CMP r14,#TYPE_GCOL ; is it a GCOL ?
MOVEQ r0,r4,LSR #8 ; if so, shift it down
SWIEQ "XColourTrans_GCOLToColourNumber" ; and convert it
MOVEQ r4,r0 ; and move to r4
; check bg
AND r14,r3,#&FF ; read the 'type' of colour
CMP r14,#TYPE_GCOL ; is it a GCOL ?
MOVEQ r0,r3,LSR #8 ; if so, shift it down
SWIEQ "XColourTrans_GCOLToColourNumber" ; and convert it
MOVEQ r3,r0 ; and move to r4
; now set the colour
LDRW r0,`font ; read font to use
BIC r1,r3,#&FF ; clear off our bottom flags (bg)
BIC r2,r4,#&FF ; clear off our bottom flags (fg)
XSWI "XColourTrans_SetFontColours",,,,14 ; select colours
; position on screen
LDR r3,[r6,#&F8] ; read graphics x
LDR r4,[r6,#&FC] ; read graphics y
......@@ -103,7 +162,12 @@ $`name
ADRW r1,`blk ; string pointer
MOV r2,#(1<<8)+(1<<4) ; given font
SWI "XFont_Paint" ; paint it
ADD r3,r3,#16 ; add 16 to cursor position
LDR r1,[r6,#&368] ; read character width
LDRW r2,`xeig ; read xeig
LDR r4,[r6,#&110] ; read cursor x in ic
ADD r4,r4,r1 ; add on width
STR r4,[r6,#&110] ; store back
ADD r3,r3,r1,LSL r2 ; add it to cursor position (xeiged)
STR r3,[r6,#&F8] ; store back again
STRW r5,`lock ; store the old lock back
LDMFD (sp)!,{r0-r6,link,pc}^ ; Return from call back to original
......@@ -114,3 +178,41 @@ $`vars
EQUD 153 ; fg
EQUD 154 ; bg
EQUD -1 ; end of list
>colourv
TEQ r8,#3 ; is it SetGCOL
BEQ setgcol ; jump to SetGCOL
TEQ r8,#&1E ; is it SetColour
BEQ setcolour
MOV pc,link ; return otherwise
>setcolour
TST r3,#1<<9 ; is it 'text' colour ?
MOV pc,link ; return if so
STMFD (sp)!,{r0-r5,link} ; Stack registers
MVN r2,#NOT -1 ; 'invalid' marker
MOV r0,r0,LSL #8 ; shift it up
ORR r0,r0,#TYPE_GCOL ; mark it as a GCOL
MOV r1,#&1000 ; base of graphics block
STREQ r2,[r1,#&48] ; fg; store as foreground
STRWEQ r0,`fg ; fg; mark as our foreground
STRNE r2,[r1,#&4C] ; bg; store as background
STRWNE r0,`bg ; bg; mark as our background
; REM "Setcolour"
LDMFD (sp)!,{r0-r5,pc} ; Return from call
>setgcol
STMFD (sp)!,{r0-r5,link} ; Stack registers
MOV r1,#&1000 ; 1000 for base
TST r3,#1<<7 ; is it foreground of background
MVN r2,#NOT -1 ; -1 marker
ORR r0,r0,#TYPE_PALETTE ; mark it as a palette
STREQ r2,[r1,#&48] ; fg; store as foreground
STRWEQ r0,`fg ; fg; mark as our foreground
STRNE r2,[r1,#&4C] ; bg; store as background
STRWNE r0,`bg ; bg; mark as our background
; REM "SetGCOL to %&0"
LDMFD (sp)!,{r0-r5,pc} ; Return from call
#post
#RUN <CODE>
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment