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