!!!Fast Graphics 8

General Information

Author: 	Carsten Strotmann \\
Language: 	ACTION! \\
Compiler/Interpreter: 	ACTION! \\
Published: 	09.12.90 \\

{{{

;********************************
;**									 **
;** Phoenix SoftCrew ACTION!	**
;**									 **
;********************************

; Programname:GR8.FAST POINT
; Programmer:CARSTEN STROTMANN
; Filename:GR8.ACT
; first Version:09.12.90
; last chnage:09.12.90
; Task:fast graphics 8 Routines
;
;


PROC Pixel=$2006 (CARD x,BYTE y)

PROC Shp=$2003 (CARD x,BYTE y)

PROC Shape (CARD x,BYTE y)

 IF x>319 THEN
  x=319
 FI
 IF y>191 THEN
  y=191
 FI

 Shp (x,y)

RETURN

PROC Line (CARD x1,y1,x2,y2)
INT fx,fy
CARD dx,dy,ful,rst,x,y,z,a,u

fx=1
fy=1
dx=x2-x1
dy=y2-y1

IF y1>y2 THEN
 dy=y1-y2
 fy=-1
FI

IF x1>x2 THEN
 dx=x1-x2
 fx=-1
FI

IF dx>dy THEN
 ful=dx/dy
 rst=dx MOD dy
 z=0
 x=x1
 y=y1
 
 DO
  z==+rst
  IF z>=dy THEN
	z==-dy
	a=ful+1
  ELSE
	a=ful
  FI
  FOR u=1 TO a
  DO 
	x==+fx
	Pixel (x,y)
  OD
  y==+fy
 UNTIL y=y2
 OD
ELSE
 ful=dy/dx
 rst=dy MOD dx
 z=0
 y=y1
 x=x1
 y=y1
 
 DO
  z==+rst
  IF z>=dx THEN
	z==-dx
	a=ful+1
  ELSE
	a=ful
  FI
  FOR u=1 TO a
  DO 
	y==+fy
	Pixel (x,y)
  OD
 x==+fx
 UNTIL x=x2
 OD
FI

RETURN

PROC HLine (CARD y,x1,x2)

CARD x

IF x1>x2 THEN
 x=x2
 x2=x1
 x1=x
FI

FOR x=x1 TO x2
DO
 Pixel (x,y)
OD

RETURN

PROC VLine (INT x,y1,y2)

BYTE y,r
CARD savmsc=$58
BYTE POINTER adr
BYTE ARRAY bit(7)=[128 64 32 16 8 4 2 1]

IF y1>191 THEN y1=191 FI
IF y2>191 THEN y2=191 FI
IF x>319 THEN x=319 FI
IF x<0 THEN x=0 FI
IF y1<0 THEN y1=0 FI
IF y2<0 THEN y2=0 FI

IF y1>y2 THEN
 y=y2
 y2=y1
 y1=y
FI

adr=y1*40+savmsc+(x/8)

r=x & 7

FOR y=y1 TO y2
DO
 IF y<191 THEN
  IF color=1 THEN
	adr^==%bit(r)
  ELSE
	adr^==!bit(r)
  FI
  adr==+40
 FI
OD

RETURN

PROC LineTo (CARD x1,y1,x2,y2)

BYTE c=$2FB

c=color

IF x1>319 THEN
  x1=319
FI
IF x2>319 THEN
  x2=319
FI
IF y1>191 THEN
  y1=191
FI
IF y2>191 THEN
  y2=191
FI

IF x1=x2 THEN 
 VLine (x1,y1,y2)
 RETURN
FI

IF y1=y2 THEN
 HLine (y1,x1,x2)
 RETURN
FI

Line (x1,y1,x2,y2)

RETURN

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)

PROC Text (CARD x,BYTE y,BYTE ARRAY tex)

BYTE len,u,ci=$2FA

len=tex(0)

FOR u=1 TO len
DO
 ci=Inter(tex(u))
 Shape (x,y)
 x==+8
OD

RETURN

INT FUNC Abs(INT n)

	IF n<0 THEN RETURN( -n ) FI
RETURN( n )

PROC Circle(INT x,y,r)

  BYTE c=$2FB
  INT Phi,Phiy,Phixy,
		x1,y1

  Phi=0
  x1=r
  y1=0
  c=color

  DO
	 Phiy=Phi+y1+y1+1
	 Phixy=Phiy-x1-x1+1
	 Pixel(x+x1,y+y1) 
	 Pixel(x-x1,y+y1) 
	 Pixel(x+x1,y-y1) 
	 Pixel(x-x1,y-y1) 
	 Pixel(x+y1,y+x1) 
	 Pixel(x-y1,y+x1) 
	 Pixel(x+y1,y-x1) 
	 Pixel(x-y1,y-x1) 
	 Phi=Phiy
	 y1=y1+1
	 IF Abs(Phixy)+0<Abs(Phiy) THEN
		Phi=Phixy
		x1=x1-1
	 FI
  UNTIL y1>x1
  OD
RETURN

PROC Disk (CARD x,y,r)

  BYTE c=$2FB
  INT Phi,Phiy,Phixy,
		x1,y1

  Phi=0
  x1=r
  y1=0
  c=color

  DO
	 Phiy=Phi+y1+y1+1
	 Phixy=Phiy-x1-x1+1
	 VLine (y+y1,x+x1,x-x1)
	 VLine (y-y1,x+x1,x-x1)
	 VLine (y+x1,x+y1,x-y1)
	 VLine (y-x1,x+y1,x-y1)
	 Phi=Phiy
	 y1=y1+1
	 IF Abs(Phixy)+0<Abs(Phiy) THEN
		Phi=Phixy
		x1=x1-1
	 FI
  UNTIL y1>x1
  OD
RETURN

PROC Box (CARD x1,y1,x2,y2)

BYTE c=$2FB
CARD x,y

c=color

IF x1>x2 THEN
 x=x1
 x1=x2
 x2=x
FI

IF y1>y2 THEN
 y=y1
 y1=y2
 y2=y
FI

FOR x=x1 TO x2
DO
 VLine (x,y1,y2)
OD

RETURN
 
PROC Frame (CARD x1,y1,x2,y2)

BYTE c=$2FB

c=color

HLine (y1,x1,x2)
HLine (y2,x1,x2)
VLine (x1,y1,y2)
VLine (x2,y1,y2)

RETURN
}}}