home *** CD-ROM | disk | FTP | other *** search
/ A.N.A.L.O.G. Magazine 1988 December / 88_dec.atr / graphics.act < prev    next >
Text File  |  2023-02-26  |  6KB  |  1 lines
  1. ; ACTION! GRAPHICS TOOLKIT¢; by Monty McCarty¢;¢; Copyright 1988¢; by ANALOG Computing¢;¢;      CHECKSUM DATA¢;[33 BD 83 64 E9 A4 E3 92 ¢; F5 59 85 A6 54 7D C5 8B ¢; B1 B8 16 2B F1 09 EC 8C ¢; F7 8F CE 4E FB D6 6A 57 ]¢¢CARD SavMsc=88,OldCol=91,¢     Xmin=[0],Xmax=[319],ET¢CARD ARRAY Line(192),TW(20)¢BYTE Color1=709,Color2=710,CPL,¢     Color4=712,CharSet=57344,¢     OldRow=90,Ymin=[1],Ymax=[192]¢BYTE ARRAY D8(320),BF(7680),CS(1024),¢     M1(0)=[128 64 32 16 8 4 2 1],¢     M2(0)=[$7F $BF $DF $EF¢            $F7 $FB $FD $FE]¢¢INT FUNC Abs(INT N)¢  IF N<0 THEN RETURN(-N) FI¢RETURN(N)¢¢PROC Screen(CARD X,BYTE Y,¢            CARD CX,BYTE CY)¢  Xmin=X Xmax=CX Ymin=Y Ymax=CY¢RETURN¢¢PROC Unclip()¢  Xmin=0 Xmax=319 Ymin=1 Ymax=192¢RETURN¢¢PROC Plot(CARD X,BYTE Y)¢  BYTE POINTER LOC¢  OldCol=X OldRow=Y¢  IF X<Xmin OR X>Xmax¢    OR Y<Ymin OR Y>Ymax THEN¢    RETURN¢  FI LOC=Line(Y)+D8(X)¢  IF COLOR#0 THEN¢    LOC^==%M1(X&7)¢    ELSE LOC^==&M2(X&7)¢  FI¢RETURN¢¢PROC Vline(BYTE Y,CY,CARD X)¢  DO Plot(X,Y) Y==+1 UNTIL Y>CY OD¢RETURN¢¢PROC Hline(CARD X,CX,BYTE Y)¢  DO Plot(X,Y) X==+1 UNTIL X>CX OD¢RETURN¢¢PROC Drawto(CARD CX BYTE CY)¢  BYTE Y,XF,YF,J,AY¢  CARD X,I,AX¢  INT A,B,T,DX,DY¢  AX=OldCol AY=OldRow Plot(AX,AY)¢  IF CX>AX THEN¢    DX=CX-AX XF=0 ELSE DX=AX-CX XF=1¢  FI¢  IF CY>AY THEN¢    DY=CY-AY YF=0 ELSE DY=AY-CY YF=1¢  FI¢  IF DX<2 AND DY<2 THEN¢    RETURN¢  FI X=AX Y=AY¢  IF DX>DY THEN¢    A=DY+DY T=A-DX B=T-DX¢      FOR I=2 TO DX DO¢       IF XF=0 THEN¢        X==+1 ELSE X==-1¢       FI¢       IF T<0 THEN¢        T==+A ELSE T==+B¢        IF YF=0 THEN¢         Y==+1 ELSE Y==-1¢        FI¢       FI Plot(X,Y)¢      OD ELSE A=DX+DX T=A-DY B=T-DY¢    FOR J=2 TO DY DO¢      IF YF=0 THEN¢       Y==+1 ELSE Y==-1¢      FI¢      IF T<0 THEN¢       T==+A ELSE T==+B¢        IF XF=0 THEN¢         X==+1 ELSE X==-1¢        FI¢      FI Plot(X,Y)¢    OD¢  FI Plot(CX,CY)¢RETURN¢¢PROC Circle(CARD X,BYTE Y,CARD R)¢  INT CIR,CIRY,CIRXY,CX,CY¢  CIR=0 CX=R CY=0¢  DO¢    CIRY=CIR+CY+CY+1¢    CIRXY=CIRY-CX-CX+1¢    Plot(X+CX,Y+CY) Plot(X-CX,Y+CY)¢    Plot(X+CX,Y-CY) Plot(X-CX,Y-CY)¢    Plot(X+CY,Y+CX) Plot(X-CY,Y+CX)¢    Plot(X+CY,Y-CX) Plot(X-CY,Y-CX)¢    CIR=CIRY CY==+1¢     IF Abs(CIRXY)+0<Abs(CIRY) THEN¢      CIR=CIRXY CX==-1¢     FI UNTIL CY>CX¢  OD¢RETURN¢¢PROC Box(CARD X,BYTE Y,¢         CARD CX,BYTE CY)¢  Hline(X,CX,Y) Vline(Y,CY,CX)¢  Hline(X,CX,CY) Vline(Y,CY,X)¢RETURN¢¢PROC Frame()¢  Box(Xmin,Ymin,Xmax,Ymax)¢RETURN¢¢PROC Move(BYTE POINTER T,F,¢          CARD L,BYTE M)¢  CARD C¢  IF M<1 OR M>4 THEN¢    M=1¢  FI C=0¢  DO¢    IF M=1 THEN¢      T^=F^¢     ELSEIF M=2 THEN¢      T^==%F^¢     ELSEIF M=3 THEN¢      T^==&F^¢     ELSEIF M=4 THEN¢      T^==!F^¢    FI F==+1 T==+1 C==+1 UNTIL C=L¢  OD¢RETURN¢¢PROC Cut(BYTE X,Y,CX,CY)¢  CARD S,E,CT¢  CT=CS S=SavMsc+(Y-1)*40+X CPL=CX-X¢  E=SavMsc+CY*40+X ET=E-S¢  DO¢    Moveblock(CT,S,CPL)¢    CT==+CPL S==+40¢    UNTIL S=E OR S>=SavMsc+7680¢  OD¢RETURN¢¢PROC Paste(BYTE X,Y,M)¢  CARD S,E,CT ¢  CT=CS S=SavMsc+(Y-1)*40+X E=S+ET¢  DO¢    Move(S,CT,CPL,M) CT==+CPL S==+40¢    UNTIL S=E OR S>=SavMsc+7680¢  OD¢RETURN¢¢PROC Print8(BYTE ARRAY ST,¢            BYTE X,Y,SZ,M)¢  CARD S,E,CT¢  BYTE A,B,C,D,LEN¢  CT=SavMsc+Y*40+X B=1 S=CT LEN=ST(0)¢  DO C=ST(B)¢    IF C>127 THEN¢     C==-126¢    FI¢    IF C>31 AND C<96 THEN¢     C==-32¢     ELSEIF C<32 THEN¢      C==+64¢    FI E=@CharSet+C*8 A=0¢    DO D=0¢     DO Move(S+40*D,E+A,1,M)¢      D==+1 UNTIL D=SZ¢     OD S==+40*SZ A==+1¢     UNTIL A=8 OR S>=7680+SavMsc¢    OD S=CT+B B==+1 UNTIL B=LEN+1¢  OD¢RETURN¢¢PROC Block(BYTE X,Y,CX,CY,F)¢  CARD S,E¢  BYTE L¢  S=SavMsc+(Y-1)*40+X¢  L=CX-X E=SavMsc+CY*40+X¢  DO¢    Setblock(S,L,F) S==+40¢    UNTIL S=E OR S>=SavMsc+7680¢  OD¢RETURN¢¢PROC OpenW(BYTE X,Y,LN,LINES,SZ,N)¢  BYTE W,H,C¢  Moveblock(BF,SavMsc,7680)¢  W=X+LN+2 H=LINES*(SZ LSH 3)+1¢  Block(X,Y,W,Y+H,0)¢  Screen(X LSH 3,Y,W LSH 3,Y+H)¢  IF N=1 THEN¢    Frame()¢  FI Unclip()¢  FOR C=0 TO LINES-1 DO¢    Print8(TW(C),X+1,Y+(SZ*8)*C,SZ,1)¢  OD¢RETURN¢¢PROC CloseW(CARD D)¢  CARD A¢  FOR A=0 TO D DO OD¢  Moveblock(SavMsc,BF,7680)¢RETURN¢¢PROC Gwindow(CARD X,BYTE Y,¢             CARD CX,BYTE CY,N)¢  CARD XA,XB¢  BYTE YA,YB¢  Screen(X,Y,CX,CY)¢  XA=(CX-X)RSH 1+X XB=XA¢  DO¢    IF XA>=X THEN¢     Vline(Y,CY,XA) XA==-1¢    FI¢    IF XB<=CX THEN ¢     Vline(Y,CY,XB) XB==+1¢    FI UNTIL XA<X¢  OD¢  IF N=1 THEN¢    Frame()¢  FI Unclip()¢RETURN¢¢PROC Init()¢  CARD I¢  BYTE POINTER LINELOC¢  LINELOC=SavMsc¢  FOR I=1 TO 192 DO¢    Line(I)=LINELOC LINELOC==+40¢  OD¢  FOR I=0 TO 319 DO¢    D8(I)=I RSH 3¢  OD¢RETURN¢¢PROC Demo()¢  CARD X,Y,C,D¢  BYTE KEY=764¢  BYTE ARRAY¢   J1="___File___Edit___Text",¢   J2="___________________"¢  GRAPHICS(24) Init() COLOR=1¢  Color1=0 Color2=12 Color4=12¢  Print8(J1,0,0,1,1)¢  Print8(J2,21,0,1,1)¢  Gwindow(25,40,300,85,1)¢  Block(5,50,10,75,128)¢  Block(11,50,16,75,127)¢  Block(17,50,23,75,229)¢  Block(24,50,30,75,170)¢  Block(31,50,36,75,85)¢  Print8("TEXT SIZE 1",0,9,1,1)¢  Print8("TEXT SIZE 2",4,16,2,1)¢  Print8("TEXT SIZE 3",8,29,3,4)¢  Screen(10,100,309,140) Frame()¢  FOR X=0 TO 360 STEP 60 DO¢    FOR D=1 TO 30 STEP 3 DO¢     Circle(X,120,D)¢    OD¢  OD Unclip()¢  FOR X=5 TO 310 STEP 15 DO¢    Box(X,170,X+10,185)¢  OD¢  TW(0)="THIS IS"¢  TW(1)="A TEST"¢  OpenW(2,9,7,2,1,1) CloseW(50000)¢  TW(0)="OF THE"¢  TW(1)="POWER OF"¢  TW(2)="THE AMAZING"¢  OpenW(9,9,11,3,2,1) CloseW(50000)¢  TW(0)="ACTION!"¢  TW(1)="GRAPHICS"¢  TW(2)="TOOLKIT"¢  OpenW(16,9,8,3,3,1)¢  Moveblock(BF,SavMsc,7680)¢  Cut(0,1,10,50)¢  FOR X=1 TO 99 DO¢    Paste(X,130,X/20)¢    Moveblock(SavMsc,BF,7680)¢  OD¢  TW(0)="PRESS ANY KEY TO EXIT" ¢  OpenW(8,84,21,1,4,1)¢  DO¢    UNTIL KEY#255¢  OD KEY=255¢RETURN¢ ¢