General Information
Author: Carsten Strotmann
Language: ACTION!
Compiler/Interpreter: ACTION!
;******************************
;** **
;** PHOENIX SOFTCREW **
;** STANDARTROUTINEN **
;** DIVERSES "DIVERS.INC" **
;******************************
MODULE
BYTE err,iostat=$23
;-----------------------------------
; clear screen
PROC Cls ()
Put (125)
RETURN
;-----------------------------------
; cursor enabled
PROC C_On ()
BYTE crsin=752
crsin=0
RETURN
;-----------------------------------
; cursor disabled
PROC C_Off ()
BYTE crsin=752
crsin=1
RETURN
;-----------------------------------
; wait some time
PROC Pause (CARD times)
BYTE wsync=$14,q
CARD u
FOR u=1 TO times
DO
FOR q=1 TO 200
DO
wsync=q
OD
OD
RETURN
;-----------------------------------
; beep tone
PROC Beep (BYTE times)
BYTE u
FOR u= 1 TO times
DO
PutD (0,253)
Pause (10)
OD
RETURN
;------------------------------------
; ATARI Rainbow effekt
PROC Rainbow (BYTE col,INT direc)
BYTE rtclok=$14,
wsync=$D40A,
vcount=$D40B,
key=764,d,e
BYTE ARRAY color(4)=$D016
key=255
WHILE key=255
DO
IF e#rtclok THEN
e=rtclok
d=0
FI
IF direc=0 THEN
d=vcount
e=0
ELSE
d==+direc
FI
wsync=rtclok
color(col)=e+d
OD
RETURN
;-----------------------------------
; Coldstart
PROC Boot=$E477 ()
;-----------------------------------
; enable / disable ANTIC DMA
PROC Scr ()
BYTE sdmctl=$22F
sdmctl==!$20
RETURN
;-----------------------------------
; query HELP-Function Key
BYTE FUNC Help ()
BYTE hplflg=$2DC
RETURN (hplflg)
;-----------------------------------
; get key
BYTE FUNC Inkey ()
BYTE atascii=$2FB,chasci=$2FC
BYTE POINTER keydefp
CARD keydef=$79
chasci=$FF
keydefp=keydef
DO
;
UNTIL chasci#$FF
OD
keydefp==+chasci
atascii=keydefp^
chasci=$FF
RETURN (atascii)
;-----------------------------------
; disable attract mode
; (screensaver)
PROC Noattr ()
BYTE attr=$4D
attr=0
RETURN
;-----------------------------------
; swap two card vars
PROC Swap (CARD a,b)
CARD x
x=a
a=b
b=x
RETURN
;-----------------------------------
; returns lowest
CARD FUNC Mini (CARD a,b)
CARD result
IF a<b THEN
result=a
ELSE
result=b
FI
RETURN (result)
;-----------------------------------
; return highest
CARD FUNC Maxi (CARD a,b)
CARD result
IF a>b THEN
result=a
ELSE
result=b
FI
RETURN (result)
;-----------------------------------
; set VBI Routine
PROC SETVBV=$E45C (BYTE mode,high,low)
PROC SetVbi (CARD vektor)
SETVBV (7,vektor/$100,vektor MOD $100)
RETURN
;-----------------------------------
; reset VBI to OS VBI Vector
PROC RstVbi ()
SetVbi ($E462)
RETURN
;----------------------------------
; set a bit in a byte
BYTE FUNC SetBit (BYTE value,bit)
BYTE dumm
dumm=1
dumm==LSH bit
value==%dumm
PrintBE (value)
RETURN (value)
;----------------------------------
; clears a bit in a byte
BYTE FUNC ClearBit (BYTE value,bit)
BYTE dumm
dumm=1
dumm==LSH bit
dumm==!$FF
value==&dumm
RETURN (value)
;-----------------------------------
; query if bit is set
BYTE FUNC AskBit (BYTE value,bit)
BYTE dumm
dumm=1
dumm==LSH bit
value==&dumm
IF value>0 THEN
value=1
FI
RETURN (value)
;-----------------------------------
; jump to DOS
PROC Dosin ()
[ $6C $0C $00 ]
;-----------------------------------
; disable BREAK-Key
PROC BreakOff ()
CARD brkky=$236
brkky==+$C
RETURN
;-----------------------------------
; Error-Handler
PROC Errhand ()
IF iostat>$7F THEN
err=iostat
ELSE
err=0
FI
RETURN
;----------------------------------
; print Error Message with Errorcode
PROC Errmess (CARD x,BYTE y)
IF err>0 THEN
PutE ()
Print ("Error - ")
PrintB (err)
FI
RETURN
;----------------------------------
; close all CIO Buffer
PROC AllClose ()
BYTE u
FOR u=1 TO 7
DO
Close (u)
OD
RETURN
;----------------------------------
; ASCII to Internal
BYTE FUNC Inter (BYTE b)
IF b>=0 AND b<32 THEN
b==+64
ELSEIF b>31 AND b<96 THEN
b==-32
ELSEIF b>127 AND b<160 THEN
b==+64
ELSEIF b>159 AND b<224 THEN
b==-32
FI
RETURN (b)
;-----------------------------------
; Internal to ASCII
BYTE FUNC Ascii (BYTE b)
IF b>=0 AND b<64 THEN
b==+32
ELSEIF b>63 AND b<96 THEN
b==-64
ELSEIF b>127 AND b<192 THEN
b==+32
ELSEIF b>191 AND b<224 THEN
b==-64
FI
RETURN (b)
;----------------------------------
; Wait for VBI
PROC Wvbi ()
BYTE rtclk=$14,u
u=rtclk
DO
;
UNTIL rtclk#u
OD
RETURN
;----------------------------------
; Return Highbyte
BYTE FUNC High (CARD value)
BYTE ret
ret=value/$100
RETURN (ret)
;----------------------------------
; return Lowbyte
BYTE FUNC Low (CARD value)
RETURN (value)
;----------------------------------
; Clicksound
PROC Click (BYTE time)
CARD u
Sound (0,30,10,8)
FOR u=1 TO time*100
DO : OD
Sound (0,0,0,0)
RETURN
;----------------------------------
; Scan Screen at position
BYTE FUNC Scan (BYTE x,y)
BYTE chr
BYTE POINTER msc
CARD savmsc=$58
msc=savmsc+y*40+x
chr=msc^
RETURN (chr)