Classic Computer Magazine Archive PROGRAM LISTING: 85-06/GR78M.ACT


; GR78M (LISTING 1)

MODULE:INT xnow=[80],ynow=[90]
BYTE cnow=[1],key=764,ram=106,cur=752
BYTE ARRAY mask7=[64 16 4 1],clor=708
  ,mask8=[128 64 32 16 8 4 2 1],mask,row
CARD dlist=560,sa=88
CARD ARRAY adr(192):CARD POINTER mes

PROC Kolor(BYTE c) RETURN
PROC Dot(INT x,y) RETURN
PROC Dit(INT x,y) RETURN

PROC LineTo(INT x,y)
INT dx,dy,xf,yf,a,b,t,i
Dot(xnow,ynow)
IF x=xnow AND y=ynow THEN RETURN FI
IF x>xnow THEN dx=x-xnow:xf=1
ELSE dx=xnow-x:xf=-1 FI
IF y>ynow THEN dy=y-ynow:yf=1
ELSE dy=ynow-y:yf=-1 FI
x=xnow:y=ynow
IF dx>dy THEN a=dy+dy:t=a-dx:b=t-dx
  FOR i=1 TO dx DO x==+xf
    IF t<0 THEN t==+a
    ELSE t==+b:y==+yf
    FI Dot(x,y)
  OD
ELSE a=dx+dx:t=a-dy:b=t-dy
  FOR i=1 TO dy DO y==+yf
    IF t<0 THEN t==+a
    ELSE t==+b:x==+xf
    FI Dot(x,y)
  OD 
FI xnow=x:ynow=y:RETURN

PROC Gr78ON():BYTE i:BYTE ARRAY dl
Graphics(8+16):adr(0)=sa:dl=dlist
FOR i= 1 TO 191 DO adr(i)=adr(i-1)+40 OD
dl==-4:dl(0)=112:dl(1)=80:dl(2)=16
FOR i=3 TO 198 DO dl(i)=dl(i+4) OD
dl(199)=16:dl(200)=66:mes=dl+201
dl(204)==-4:dlist=dl:RETURN

PROC Kolor7(BYTE c):BYTE i
c==& 3:cnow=c
FOR i=0 TO 3 DO mask(3-i)=c:c==LSH 2 OD
RETURN

PROC Dot7(INT x,y):BYTE xb,xr
BYTE ARRAY pre=[63 207 243 252]
IF x<0 OR x>159 THEN RETURN FI
IF y<0 OR y>191 THEN RETURN FI
xb=x RSH 2:xr=x AND 3:row=adr(y)
row(xb)==& pre(xr) % mask(xr):RETURN

PROC Dit7(INT x,y):BYTE xb,xr
IF x<0 OR x>159 THEN RETURN FI
IF y<0 OR y>191 THEN RETURN FI
xb=x RSH 2:xr=x AND 3:row=adr(y)
row(xb)==! mask(xr):RETURN

PROC Gr7(BYTE ARRAY d):BYTE i
mask=mask7:Kolor=Kolor7:Dot=Dot7
Dit=Dit7:d(3)=78:d(99)=78
FOR i=6 TO 98 DO d(i)=14 OD
FOR i=102 TO 198 DO d(i)=14 OD:RETURN

PROC Kolor8(BYTE c):BYTE i
cnow=c & 3:IF c>1 THEN c=1 FI
FOR i=0 TO 7 DO mask(7-i)=c:c==LSH 1 OD
RETURN

PROC Dot8(INT x,y):BYTE xb,xr
BYTE ARRAY
  pre=[127 191 223 239 247 251 253 254]
IF x<0 OR x>319 THEN RETURN FI
IF y<0 OR y>191 THEN RETURN FI
xb=x RSH 3:xr=x AND 7:row=adr(y)
row(xb)==& pre(xr) % mask(xr):RETURN

PROC Dit8(INT x,y):BYTE xb,xr
IF x<0 OR x>319 THEN RETURN FI
IF y<0 OR y>191 THEN RETURN FI
xb=x RSH 3:xr=x AND 7:row=adr(y)
row(xb)==! mask(xr):RETURN

PROC Gr8(BYTE ARRAY d):BYTE i
mask=mask8:Kolor=Kolor8:Dot=Dot8
Dit=Dit8:d(3)=79:d(99)=79
FOR i=6 TO 98 DO d(i)=15 OD
FOR i=102 TO 198 DO d(i)=15 OD:RETURN


Back to previous page