@C9Source Code LightBeep

@C7
This module adds a screen flash to the system beep. This is done by intercepting
the VDU call '7'. To be sure that this '7' sent over the WriteChar Vector isn`t
a data one, we keep track of all VDU calls, that expect parameters, the number
of parameters needed is stored and no further check is done until all parameters
were sent. If a BELL is detected, the palette is inverted using the OS_Word
'Write Palette', a CallAfter is set up that, after a configurable time, re-in-
verts the palette. The user recognizes a flashing screen. For further informa-
tion read the comment statements.
                                                         fRISCo / Archiologics
@C3
REM  Light-Beep - Archiologics

DIM CODE% 1000

FOR pass%=4 TO 6 STEP 2

P%=0:O%=CODE%
[ OPT pass%

\ module header

EQUD 0                          ; Startup code
EQUD init                       ; initialisation code
EQUD final                      ; finalisation code
EQUD 0                          ; service call handling code
EQUD title                      ; module title
EQUD helpstring                 ; module help string
EQUD commands                   ; command table

.title                          ; Titelstring
EQUS "LightBeep"
EQUB 0:ALIGN

.helpstring                     ; Helpstring
EQUS "LightBeep"+CHR$9+"1.00 (07 Jan 1996) 1996 Archiologics"
EQUB 0:ALIGN

.commands                       ; commandtabelle
EQUS "LightBeep":EQUB 0:ALIGN   ; commandname
EQUD 0                          ; no commandcode
EQUD 0                          ; no parameters
EQUD 0                          ; no invalid syntax string
EQUD helpmod                    ; helpoffset
EQUS "LightBeepDelay":EQUB 0:ALIGN
EQUD setbeepdelay               ; addresse of commandcode
EQUD &00010000                  ; min. 0, max. 1 parameter
EQUD syntax                     ; invalid syntax error string
EQUD delayhelp                  ; commandhelpoffset
EQUD 0

.delayhelp                      ; commandhelp
EQUS "*LightBeepDelay sets the LightBeep`s duration in cs":EQUB 13:EQUB 10
EQUS "*LightBeepDelay 0 turns the LightBeep off":EQUB 13:EQUB 10
EQUS "*LightBeepDelay without parameter shows current state":EQUB 13:EQUB 10
.syntax
EQUS "Syntax: *LightBeepDelay [0|(1-32)]":EQUB 0:ALIGN

.helpmod
EQUS "Flashes screen when beep":EQUB 0:ALIGN

; =================== Set Delay Command Code ===============================
.setbeepdelay
STMFD R13!,{R0-R4,R14}          ; stack registers
CMP   R1,#0                     ; is number of parameters 0?
BEQ   anzeigen                  ; if so, print delay
MOV   R1,R0                     ; if not
MOV   R0,#10                    ; read the
SWI   "XOS_ReadUnsigned"        ; new delay
CMP   R2,#32                    ; is it greater than 32
BGT   fehler
CMP   R2,#0                     ; or smaller 0
BLT   fehler                    ; print error string
STR   R2,delay                  ; if the value is correct, set up new delay
LDMFD R13!,{R0-R4,PC}^          ; load registers from stack, return
.fehler
LDMFD R13!,{R0-R4,R14}          ; load registers from stack,
ADR    R0,syntax-4              ; set up pointer to syntaxstring
ORRS   PC,R14,#1<<28            ; set V and return
.anzeigen
LDR   R0,delay                  ; load delay
CMP   R0,#0                     ; if it`s 0,
BEQ   isoff                     ; print 'currently turned off'
ADD   R0,R0,#10                 ; increase by 10  (it later helps
                                ; to get e.g. an '06')
ADR   R1,buf                    ; pointer to output buffer
MOV   R2,#3                     ; size of buffer
SWI   "XOS_BinaryToDecimal"     ; convert delay
LDRB  R0,buf                    ; load tens
SUB   R0,R0,#1                  ; sub the 10 we added above
STRB  R0,hierher                ; and store it to output string
LDRB  R0,buf+1                  ; load unit
STRB  R0,hierher+1              ; and store it to output string
ADR   R0,ausgabestring          ; pointer to output string
SWI   "XOS_Write0"              ; print
LDMFD R13!,{R0-R4,PC}^          ; load registers from stack, return
.ausgabestring
EQUS "Current LightBeepDelay: "

.hierher
EQUS "   cs":EQUB 13:EQUB 10:EQUB 0:ALIGN

.buf
EQUD 0

.isoff
ADR   R0,isnton                 ; pointer to message ...
SWI   "XOS_Write0"              ; ... and print
LDMFD R13!,{R0-R4,PC}^          ; load registers from stack, return

.isnton
EQUS "LightBeep currently turned off.":EQUB 13:EQUB 10:EQUB 0:ALIGN

; =============================== init ====================================

.init
STMFD R13!,{R0-R2,R14}          ; stack registers
MOV R0,#3                       ; WriteChar Vector number
ADR R1,WrchV                    ; addresse of routine
MOV R2,#15                      ; Value of R12
SWI "XOS_Claim"                 ; claim WriteChar vector
LDMFD R13!,{R0-R2,PC}^          ; load registers from stack, return

.table EQUB 0:EQUB 1:EQUB 0:EQUB 0:EQUB 0:EQUB 0:EQUB 0:EQUB 0:EQUB 0:EQUB 0
       EQUB 0:EQUB 0:EQUB 0:EQUB 0:EQUB 0:EQUB 0:EQUB 0:EQUB 1:EQUB 2:EQUB 4
       EQUB 0:EQUB 0:EQUB 1:EQUB 9:EQUB 8:EQUB 5:EQUB 0:EQUB 0:EQUB 4:EQUB 4
       EQUB 0:EQUB 2

; ========================= VSync Event handler ============================
.WrchV
STMFD R13!,{R0-R2,R14}

LDRB R1,parameters               ; load number of VDU - parameters
SUBS R1,R1,#1                    ; - increase
STRGEB R1,parameters             ; - store
LDMGEFD R13!,{R0-R2,PC}^         ; - if it`s been a data call
                                 ;   immediate return

; check VDUs and set up number of parameters
CMP  R0,#31                      ; >32 => no VDU, but character...
LDMGTFD R13!,{R0-R2,PC}^         ; and return

ADR  R1,table                    ; pointer to parameter table
LDRB R1,[R1,R0]                  ; load number of parameters for VDU
STRB R1,parameters               ; and set `em up

CMP R0,#7                        ; intercept VDU 7
LDMNEFD R13!,{R0-R2,PC}^         ; if it isn`t '7' return

LDR R0,delay                     ; is delay = 0 => turned off
CMP R0,#0                        ;
LDMEQFD R13!,{R0-R2,PC}^         ; then return

LDR R0,active                    ; is already a flash
CMP R0,#0                        ; active
LDMNEFD R13!,{R0-R2,PC}^         ; then return

; invert palette
ADR R1,palette                  ; 5 byte block for OS_Word
.col_loop

  MOV R0,#11:STRB R12,[R1]      ; parameter for OS_Word 'read palette'
  SWI "XOS_Word"                ; read original entry

  LDRB R2,[R1,#2]:RSB R2,R2,#255:STRB R2,[R1,#2] ; invert red
  LDRB R2,[R1,#3]:RSB R2,R2,#255:STRB R2,[R1,#3] ; invert green
  LDRB R2,[R1,#4]:RSB R2,R2,#255:STRB R2,[R1,#4] ; invert blue

  MOV R0,#12:SWI "XOS_Word"     ; set up inverted entry

SUBS R12,R12,#1:BGE col_loop    ; next entry
LDR  R0,delay                   ; delay in centiseconds
ADR  R1,back                    ; set up pointer to reinverter
MOV  R2,#15                     ; Value for R12
SWI  "XOS_CallAfter"            ; call routine after <Delay> cs
STR  R2,active                  ; set up 'flash in progress' flag

LDMFD R13!,{R0-R2,PC}^          ; load registers from stack, return

.active EQUD 0                  ; 'flash in progress' flag

; ========================== original colour ===============================
.back     
STMFD  R13!,{R0-R3,R14}         ; stack originalmode register
MOV    R3,PC                    ; save prozessor flags
BICS   R1,R3,#3                 ; set bit 0 und 1 to 0
TEQP   R1,#3                    ; result is SVC mode
STMFD  R13!,{R14}               ; stack it`s R14
ADR R1,palette                  ; 5 byte block. for OS_Word
.col_loop

  MOV R0,#11:STRB R12,[R1]      ; parameter for OS_Word read palette
  SWI "XOS_Word"                ; read inverted palette entry

  LDRB R2,[R1,#2]:RSB R2,R2,#255:STRB R2,[R1,#2]; reinvert red
  LDRB R2,[R1,#3]:RSB R2,R2,#255:STRB R2,[R1,#3]; reinvert green
  LDRB R2,[R1,#4]:RSB R2,R2,#255:STRB R2,[R1,#4]; reinvert blue

  MOV R0,#12:SWI "XOS_Word"     ; store reinverted palette entry

SUBS R12,R12,#1:BGE col_loop    ; next entry
MOV    R0,#0                    ; set 'flash in progress'
STR    R0,active                ; to zero
LDMFD  R13!,{R14}               ; load R14_svc
TEQP   R3,#0                    ; back to original mode
LDMFD  R13!,{R0-R3,PC}^         ; load originalmoderegister, return

.delay EQUD 5                   ; delay !!!

; =============================== final ====================================
.final
STMFD R13!,{R0-R2,R14}
MOV R0,#3                       ; WriteChar Vector number
ADR R1,WrchV                    ; address of routine
MOV R2,#15                      ; Value of R12
SWI "XOS_Release"               ; release
LDMFD R13!,{R0-R2,PC}^

.palette EQUB 0:EQUD 0          ; 5 byte block for Palette Change
.parameters EQUD B              ; number of VDU parameters

]
NEXT pass%

SYS "XOS_Module",11,CODE%,O%-CODE%        :*| Immediately installed
SYS "XOS_CLI","SAVE RAM:LightBeep "+STR$~CODE%+" + "+STR$~(O%-CODE%)
SYS "XOS_CLI","SETTYPE RAM:$.LightBeep FFA"

