@C9Source Code LightBeep

@C7
Dieses Modul fgt dem Systembeep noch ein Aufflashen des Bildschirms hinzu. Dies
wird durch das Abfangen des VDU '7' erreicht. Um sicherzugehen, da eine ber
den WriteChar Vector gesendete '7' keine Daten-'7' ist, werden alle VDU's, die
nachfolgende Parameter verlangen, kontrolliert, und die Anzahl dieser Parameter
gespeichert, fr die Zeit der Abarbeitung dieser Parameter bleiben alle weiteren
Checks gesperrt. Mit dem OS_Word 'Palette Write' wird die Palette invertiert,
ein 'CallAfter' wird ausgesetzt, der nach einer bestimmten (mit einem CLI-
Kommando konfigurierbaren) Zeit aufgerufen wird. Dieser invertiert die Palette
nochmal und setzt sie damit auf den Ursprungszustand zurck. Dem Anwender fllt
dies als flashender Bildschirm auf. Alles genauere entnehme man den Kommentar-
statements.
                                                         fRISCo / Archiologics
@C3
REM  Light-Beep - Archiologics

DIM CODE% 1000

FOR durchl%=4 TO 6 STEP 2

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

\ 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                          ; Modultitel
EQUS "LightBeep"
EQUB 0:ALIGN

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

.commands                       ; Kommandotabelle
EQUS "LightBeep":EQUB 0:ALIGN   ; Name d. Kommandos
EQUD 0                          ; Kein  commandcode
EQUD 0                          ; Keine Parameter
EQUD 0                          ; Kein  Invalid Syntax String
EQUD helpmod                    ; Hilfeoffset
EQUS "LightBeepDelay":EQUB 0:ALIGN
EQUD setbeepdelay               ; Adresse d. commandcodes
EQUD &00010000                  ; min. 0, max. 1 Parameter
EQUD syntax                     ; Invalid Syntax Fehler string
EQUD delayhelp                  ; Kommandohilfe
EQUD 0

.delayhelp                      ; Kommandohilfe
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}          ; Register auf den Stack
CMP   R1,#0                     ; Anzahl der Parameter 0?
BEQ   anzeigen                  ; Wenn ja, den Delay ausgeben
MOV   R1,R0                     ; Wenn nein,
MOV   R0,#10                    ; den angegebenen Parameter
SWI   "XOS_ReadUnsigned"        ; einlesen
CMP   R2,#32                    ; ist er groesser als 32
BGT   fehler
CMP   R2,#0                     ; oder kleiner als 0
BLT   fehler                    ; dann Fehlerstring ausgeben
STR   R2,delay                  ; Wenn korrekter Wert, speichern
LDMFD R13!,{R0-R4,PC}^          ; Register vom Stack, Ruecksprung
.fehler
LDMFD R13!,{R0-R4,R14}          ; Register vom Stack,
ADR    R0,syntax-4              ; Syntaxstring adressieren
ORRS   PC,R14,#1<<28            ; V-Flag setzen und Ruecksprung
.anzeigen
LDR   R0,delay                  ; Delay laden
CMP   R0,#0                     ; wenn er 0 ist,
BEQ   isoff                     ; 'currently turned off' ausgeben
ADD   R0,R0,#10                 ; Zehn addieren (damit auch
                                ; einstellige Zahlen zweistellig
                                ; werden)
ADR   R1,buf                    ; den Ausgabebuffer adressieren
MOV   R2,#3                     ; Laenge des Buffers
SWI   "XOS_BinaryToDecimal"     ; Zahl konvertieren
LDRB  R0,buf                    ; Zehnerstelle laden
SUB   R0,R0,#1                  ; Den Zehner von oben abziehen
STRB  R0,hierher                ; in den Ausgabestring speichern
LDRB  R0,buf+1                  ; Die Einerstelle laden
STRB  R0,hierher+1              ; in den Ausgabestring speichern
ADR   R0,ausgabestring          ; Ausgabestring
SWI   "XOS_Write0"              ; plotten
LDMFD R13!,{R0-R4,PC}^          ; Register vom Stack, Ruecksprung
.ausgabestring
EQUS "Current LightBeepDelay: "

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

.buf
EQUD 0

.isoff
ADR   R0,isnton                 ; Nachricht adressieren
SWI   "XOS_Write0"              ; und ausgeben
LDMFD R13!,{R0-R4,PC}^          ; Register vom Stack, Ruecksprung

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

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

.init
STMFD R13!,{R0-R2,R14}          ; Register auf den Stack
MOV R0,#3                       ; WriteChar Vector Nummer
ADR R1,WrchV                    ; Adresse der Routine
MOV R2,#15                      ; Wert fuer R12
SWI "XOS_Claim"                 ; WriteChar Vector claimen
LDMFD R13!,{R0-R2,PC}^          ; Register viom Stack

.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,gesperrt                 ; Anzahl der gesperrten Aufrufe laden
SUBS R1,R1,#1                    ; - verringern
STRGEB R1,gesperrt               ; - speichern
LDMGEFD R13!,{R0-R2,PC}^         ; - wenn es ein gesperrter
                                 ; VDU war, gleich zurueck

; VDUs testen und Anz. d. gesperrten Aufrufe setzen
CMP  R0,#31                      ; >32 => kein VDU, sonder Character
LDMGTFD R13!,{R0-R2,PC}^         ; dann gleich zurueck

ADR  R1,table                    ; Parametertabelle adressieren
LDRB R1,[R1,R0]                  ; Anzahl der Parameter f. d. VDU lesen
STRB R1,gesperrt                 ; und gesperrte Aufrufe setzen

CMP R0,#7                        ; VDU 7 abfangen
LDMNEFD R13!,{R0-R2,PC}^         ; wenn nicht, auch zurueck

LDR R0,delay                     ; Kommando ausgeschaltet?
CMP R0,#0                        ;           -''-
LDMEQFD R13!,{R0-R2,PC}^         ; wenn ja zurueck

LDR R0,active                    ; schon ein Flash
CMP R0,#0                        ; im Gange?
LDMNEFD R13!,{R0-R2,PC}^         ; Wenn ja, dann zurueck

; Farbpalette invertieren
ADR R1,palette                  ; Adresse d. 5 Byte Block. f. OS_Word
.col_loop

  MOV R0,#11:STRB R12,[R1]      ; Parameter f. OS_Word 'read palette'
  SWI "XOS_Word"                ; Palette f. aktuelle Farbe lesen

  LDRB R2,[R1,#2]:RSB R2,R2,#255:STRB R2,[R1,#2] ; Rot invertieren
  LDRB R2,[R1,#3]:RSB R2,R2,#255:STRB R2,[R1,#3] ; Gruen invertieren
  LDRB R2,[R1,#4]:RSB R2,R2,#255:STRB R2,[R1,#4] ; Blau invertieren

  MOV R0,#12:SWI "XOS_Word"     ; invertierte Palette f. akt. Farbe schreiben

SUBS R12,R12,#1:BGE col_loop    ; naechste Farbe
LDR  R0,delay                   ; Delay in Centisekunden
ADR  R1,zurueck                 ; Farben - Re - 'inverter' adressieren
MOV  R2,#15                     ; Wert f. R12
SWI  "XOS_CallAfter"            ; Nach <Delay> cs Routine aufrufen
STR  R2,active                  ; Merken, dass gerade ein Flash im Gange ist

LDMFD R13!,{R0-R2,PC}^          ; Register vom Stack, Ruecksprung

.active EQUD 0                  ; Flash im Gange Flag

; ========================== Farben original ===============================
.zurueck
STMFD  R13!,{R0-R3,R14}         ; Originalmode Register auf den Satck
MOV    R3,PC                    ; Prozessor Flags uebergeben
BICS   R1,R3,#3                 ; Bit 0 und 1 auf 0
TEQP   R1,#3                    ; Ergebnis (siehe Modulekurs) SVC mode
STMFD  R13!,{R14}               ; dessen R14 auf den Stack
ADR R1,palette                  ; Adresse d. 5 Byte Block. f. OS_Word
.col_loop

  MOV R0,#11:STRB R12,[R1]      ; Parameter f. OS_Word read palette
  SWI "XOS_Word"                ; Palette f. akt. Farbe lesen

  LDRB R2,[R1,#2]:RSB R2,R2,#255:STRB R2,[R1,#2]; Rot invertieren
  LDRB R2,[R1,#3]:RSB R2,R2,#255:STRB R2,[R1,#3]; Gruen invertieren
  LDRB R2,[R1,#4]:RSB R2,R2,#255:STRB R2,[R1,#4]; Blau invertieren

  MOV R0,#12:SWI "XOS_Word"     ; invertierte Palette f. akt. Farbe schreiben

SUBS R12,R12,#1:BGE col_loop    ; naechste Farbe
MOV    R0,#0                    ; Flash ist im Gange-
STR    R0,active                ; Flag auf Null setzen
LDMFD  R13!,{R14}               ; R14_svc laden
TEQP   R3,#0                    ; zurueck in den Originalmodus
LDMFD  R13!,{R0-R3,PC}^         ; Originalmoderegister vom Stack, Ruecksprung

.delay EQUD 5                   ; DER Delay !!!

; =============================== final ====================================
.final
STMFD R13!,{R0-R2,R14}
MOV R0,#3                       ; WriteChar Vector Nummer
ADR R1,WrchV                    ; Adresse der routine
MOV R2,#15                      ; Wert f. R12
SWI "XOS_Release"               ; freigeben
LDMFD R13!,{R0-R2,PC}^

.palette EQUB 0:EQUD 0          ; 5 Byte Block f. Palette Change
.gesperrt EQUB 0                ; Anzahl der gesperrten Aufrufe

]
NEXT durchl%

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

