A.N.A.L.O.G. Magazine 1988 October/88_oct.atr/advpedit.act

Text File | 2023-02-26 | 8KB | 2 lines

;IJגשIJמבדג PRINT SHOP GRAPHIC EDITOR¢;MAIN PROGRAM¢;D:ADVPEDIT.ACT¢;by ROBERT PLOTKIN¢;COPYRIGHT 1988 BY ANALOG COMPUTING¢;¢;      CHECKSUM DATA¢;[00 BB 45 B1 6D 66 30 56 ¢; F0 E7 76 B4 87 24 DB 46 ¢; 6E 9F 7B B0 7A FC 70 FD ¢; 27 0B E4 04 93 B2 91 7E ¢; 55 9B C3 43 DA 96 BE 73 ¢; F6 DC AC AE 2F 21 8A ]¢¢BYTE I,J,K,CNTOLD,CNTNEW,A,C,CON,¢     COLOVER,BITE,BIT,XD,YD,TEXTURE,¢     GX,GY,RX,RY,DRAW,LMODE,PN,LNUM¢BYTE ARRAY XB1($100),YB1($100),¢     XB2($100),YB2($100),GRPH(572),¢     SCREEN,¢     SQ=[128 64 32 16 8 4 2 1],¢     DIGIT="00"¢CARD SPEED=[0]¢¢PROC MYERR(BYTE ERR) RETURN¢;Ignore BREAK key¢¢BYTE FUNC GRAPHIC(BYTE X,Y)¢BYTE ARRAY MASK=¢     [128 64 32 16 8 4 2 1]¢RETURN(GRPH(Y*11+X RSH 3)¢       RSH(7!(X&7))&1)¢¢PROC PGRAPHIC(BYTE X,Y,VAL)¢BYTE ARRAY MASK=[127 191 223 239 247¢ 251 253 254]¢BITE=X&7¢GRPH(Y*11+X RSH 3)==&MASK(BITE)%¢                     VAL LSH(7!BITE)¢RETURN¢¢PROC GRVALS(BYTE X,Y)¢RX=X LSH 1 RY=24+3*Y¢RETURN¢¢PROC PLOT8(BYTE X BYTE Y)¢BYTE POINTER POS¢BYTE ARRAY MASK=[127 191 223 239 247¢ 251 253 254]¢POS=SCREEN+Y*40+X RSH 3 BITE=X&7¢POS^==&MASK(BITE)%COLOR LSH (7!BITE)¢RETURN¢¢PROC PLOTG(BYTE X,Y)¢GRVALS(X,Y)¢PLOT8(RX,RY)   PLOT8(RX+1,RY)¢PLOT8(RX,RY+1) PLOT8(RX+1,RY+1)¢PLOT8(RX,RY+2) PLOT8(RX+1,RY+2)¢RETURN¢¢PROC PPLOTG(BYTE X,Y,VAL)¢PLOTG(X,Y) PGRAPHIC(X,Y,VAL)¢RETURN¢¢PROC PUT8(BYTE X,Y,CHR)¢BYTE INV¢BYTE POINTER POS,CHPOS¢POS=SCREEN+Y*320+X¢INV=CHR&128 CHR==&127¢IF INV=128 THEN INV=255 FI¢IF CHR>31 AND CHR<96 THEN CHR==-32¢ ELSEIF CHR<32 THEN CHR==+64 FI¢CHPOS=57344+CHR*8¢FOR I=0 TO 7 DO¢ POS^=CHPOS^!INV POS==+40 CHPOS==+1¢OD¢RETURN¢¢PROC PRINT8(BYTE X,Y¢            BYTE ARRAY WORD)¢FOR J=1 TO WORD(0) DO¢ PUT8(X+J-1,Y,WORD(J))¢OD¢RETURN¢¢PROC KEEP(BYTE TX,TY)¢IF TX=88 OR TX=255 OR¢   TY=52 OR TY=255 THEN RETURN¢FI¢IF GRAPHIC(TX,TY)#COLOVER THEN¢ IF TEXTURE=2 THEN¢  IF GRAPHIC(TX-XD,TY)=COLOVER AND¢     GRAPHIC(TX,TY-YD)=COLOVER THEN¢   RETURN¢  FI¢ FI¢ PPLOTG(TX,TY,COLOR!1)¢ XB2(CNTNEW)=TX YB2(CNTNEW)=TY¢ CNTNEW==+1¢FI¢RETURN¢¢PROC FILL()¢BYTE ARRAY XDIR=[1 255 0 0],¢           YDIR=[0 0 1 255],¢           XDIR2=[1 1 255 255],¢           YDIR2=[255 1 1 255]¢;Diamond Fill Subroutine¢;From ANALOG #16, February 1984¢;Translated to ACTION! by¢;Robert Plotkin¢XB1(0)=GX YB1(0)=GY¢IF GRAPHIC(GX,GY)=COLOVER THEN¢ RETURN¢FI PPLOTG(GX,GY,COLOVER)¢CNTOLD=1¢DO CNTNEW=0¢ FOR I=1 TO CNTOLD DO¢  FOR J=0 TO 3 DO¢   IF TEXTURE=2 THEN¢    XD=XDIR2(J) YD=YDIR2(J)¢   ELSE XD=XDIR(J) YD=YDIR(J)¢   FI KEEP(XB1(I-1)+XD,YB1(I-1)+YD)¢  OD¢ OD CNTOLD=CNTNEW¢ IF CNTOLD=0 THEN EXIT FI¢ MOVEBLOCK(YB1,YB2,CNTOLD)¢ MOVEBLOCK(XB1,XB2,CNTOLD)¢OD¢RETURN¢¢PROC CLEARSCREEN()¢ZERO(SCREEN,7680)¢RETURN¢¢PROC SGRAPHIC()¢BYTE MASK,L¢CARD GPOS,SPOS¢GPOS=0 SPOS=960¢FOR I=0 TO 51 DO¢ FOR J=0 TO 10 DO MASK=128¢  FOR K=0 TO 1 DO BIT=0 BITE=0¢   FOR L=0 TO 3 DO¢    IF (MASK&GRPH(GPOS))=0 THEN¢     BITE==%SQ(BIT)%SQ(BIT+1)¢    FI BIT==+2 MASK==RSH 1¢   OD¢   SCREEN(SPOS)=BITE¢   SCREEN(SPOS+40)=BITE¢   SCREEN(SPOS+80)=BITE SPOS==+1¢  OD GPOS==+1¢ OD SPOS==+98¢OD¢RETURN¢¢PROC MAKENUM(BYTE NUM)¢IF NUM<10 THEN¢ DIGIT(1)=0 ELSE¢ DIGIT(1)=NUM/10¢FI DIGIT(2)=NUM MOD 10¢RETURN¢¢PROC SDIGIT(BYTE X)¢PUT8(X,23,DIGIT(1)+48)¢PUT8(X+1,23,DIGIT(2)+48)¢RETURN¢¢PROC SHOWXY()¢MAKENUM(GX) SDIGIT(5)¢MAKENUM(GY) SDIGIT(12)¢RETURN¢¢PROC CLEARSLINE()¢FOR J=0 TO 39 DO PUT8(J,2,32) OD¢RETURN¢¢PROC SHOWSPECS()¢CARD ARRAY DON(2),FON(3),LON(3)¢DON(0)="OFF" DON(1)="ON "¢FON(0)="OFF    " FON(1)="PURE  "¢FON(2)="CHECKER"¢LON(0)="OFF       "¢LON(1)="CONTINUOUS"¢LON(2)="RAY       "¢PRINT8(7,2,DON(DRAW))¢PRINT8(16,2,FON(TEXTURE))¢PRINT8(29,2,LON(LMODE))¢RETURN¢¢PROC INITVALS()¢GX=44 GY=25 TEXTURE=0 DRAW=1 C=0¢CON=0 LMODE=0¢RETURN¢¢PROC CLEARGRAPHIC()¢ZERO(GRPH,572) INITVALS()¢RETURN¢¢PROC STATLINE()¢PRINT8(2,2,"גפIJת-    החככ-        ")¢PRINT8(24,2,"כחמד-         ")¢RETURN¢¢PROC PCMD(BYTE ARRAY TEXT)¢PRINT8(25,LNUM,TEXT) LNUM==+1¢RETURN¢¢PROC DRAWSCREEN()¢GRAPHICS(24) SCREEN=PEEKC(88)¢SGRAPHIC() PRINT8(2,0,¢"áIJגשIJמבדגáספחמקáצזנסáופIJסזחבáדגחקנפ"¢) STATLINE()¢PRINT8(27,4,"בנללIJמגצ") LNUM=6¢PCMD("ח OR ¡>UP") PCMD("ט OR ½>LEFT")¢PCMD("י OR ¬>RIGHT")¢PCMD("ל OR ©>DOWN")¢PCMD("ג>DRAW TOGGLE")¢PCMD("ה>FILL TOGGLE")¢PCMD("כ>LINE TOGGLE")¢PCMD("מ>NEGATE")¢PCMD("ם>SPEED( )") PCMD(" ")¢PCMD("בקפכ¡ב>CLEAR")¢PCMD("בקפכ¡ע>QUIT")¢PCMD("בקפכ¡צ>SAVE")¢PCMD("בקפכ¡ל>MOIRE")¢PCMD("בקפכ¡ח>INVERT")¢PCMD("בקפכ¡ו>LOAD")¢PUT8(33,14,(SPEED/750)+48)¢PRINT8(3,23,"X=") PRINT8(10,23,"Y=")¢SHOWXY() SHOWSPECS()¢RETURN¢¢INCLUDE"D:PSHOPIO.ACT"¢;GET SAVE&LOAD ROUTINES¢¢PROC LINE(BYTE X1,Y1,X2,Y2)¢;Drawto subroutine¢;From SPLASH IN ACTION!¢;ANTIC Volume 3, Number 4  April 1985¢BYTE X,Y,XF,YF¢INT A,B,T,DX,DY¢PPLOTG(X1,Y1,DRAW) PPLOTG(X2,Y2,DRAW)¢IF X2>X1 THEN DX=X2-X1 XF=0¢ELSE DX=X1-X2 XF=1¢FI¢IF Y2>Y1 THEN DY=Y2-Y1 YF=0¢ELSE DY=Y1-Y2 YF=1¢FI¢IF DX<2 AND DY<2 THEN RETURN FI¢X=X1 Y=Y1¢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 PPLOTG(X,Y,DRAW)¢ OD¢ELSE¢ A=DX+DX T=A-DY B=T-DY¢ FOR I=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 PPLOTG(X,Y,DRAW)¢ OD¢FI¢RETURN¢¢PROC NEGATE()¢CARD GPOS¢FOR GPOS=0 TO 571 DO GRPH(GPOS)==!255¢OD SGRAPHIC()¢RETURN¢¢PROC INVERT()¢BYTE ARRAY TLINE(11)¢CARD POS1,POS2¢FOR I=0 TO 25 DO¢ POS1=GRPH+I*11 POS2=GRPH+(51-I)*11¢ MOVEBLOCK(TLINE,POS1,11)¢ MOVEBLOCK(POS1,POS2,11)¢ MOVEBLOCK(POS2,TLINE,11)¢OD SGRAPHIC()¢RETURN¢¢PROC CNGCOLOR()¢DRAW=C C==!1 COLOR=C¢RETURN¢¢PROC MLINE(BYTE X,Y)¢LINE(44,25,X,Y) CNGCOLOR()¢RETURN¢¢PROC MOIRE(BYTE MNUM)¢BYTE TXY,TEMPD¢TEMPD=DRAW¢IF MNUM=1 THEN ¢ FOR TXY=0 TO 87 DO LINE(0,0,TXY,51)¢  CNGCOLOR() OD¢ FOR TXY=0 TO 87 DO LINE(87,51,TXY,0)¢  CNGCOLOR() OD¢ELSE¢ FOR TXY=0 TO 87 DO MLINE(TXY,51) OD¢ FOR TXY=0 TO 51 DO MLINE(87,TXY) OD¢ FOR TXY=0 TO 87 DO MLINE(TXY,0) OD¢ FOR TXY=0 TO 51 DO MLINE(0,TXY) OD¢FI DRAW=TEMPD C=DRAW!1¢RETURN¢¢PROC MAIN()¢BYTE ST,MASK,KEY=764,MOVE¢BYTE ARRAY XDIR=[0 0 255 1],¢     YDIR=[255 1 0 0],XP(2),YP(2),¢     MKEY1=['-'='+'*],¢     MKEY2=['I'M'J'K]¢CARD SCNT=[0]¢DRAWSCREEN() KEY=255¢DO CON==!1 COLOR=CON PLOTG(GX,GY)¢ IF STRIG(0)=0 THEN¢  IF LMODE THEN XP(PN)=GX YP(PN)=GY¢   IF PN THEN COLOR=C¢    LINE(XP(0),YP(0),GX,GY)¢    IF LMODE=1 THEN XP(0)=GX YP(0)=GY¢    FI¢   FI PN==%1¢  ELSEIF TEXTURE=0 THEN COLOR=C¢   PPLOTG(GX,GY,DRAW)¢  ELSE COLOR=C COLOVER=DRAW FILL()¢  FI¢ FI ST=STICK(0) MOVE=0¢ IF KEY=255 THEN A=0 ELSE A=GETD(1)¢ FI¢ IF ST#15 OR A#0 THEN ¢  FOR SCNT=0 TO SPEED DO OD¢  COLOR=GRAPHIC(GX,GY)!1 PLOTG(GX,GY)¢  MASK=1¢  FOR I=0 TO 3 DO¢   IF (ST&MASK)=0 OR¢   A=MKEY1(I) OR A=MKEY2(I) THEN¢    GX==+XDIR(I) GY==+YDIR(I) MOVE=1¢   FI MASK==LSH 1¢  OD¢  IF GY=255 THEN GY=51 FI¢  IF GY=52 THEN GY=0 FI¢  IF GX=255 THEN GX=87 FI¢  IF GX=88 THEN GX=0 FI¢  SHOWXY()¢ FI¢ IF A='F THEN¢  TEXTURE==+1 LMODE=0¢  IF TEXTURE=3 THEN TEXTURE=0 FI¢ ELSEIF A='D THEN¢  DRAW==!1 C==!1¢ ELSEIF A='⇨ THEN ;CTRL-C¢  CLEARSLINE() PRINT8(2,2,¢  "<RETURN> TO CLEAR GRAPHIC AREA")¢  A=GETD(1)¢  IF A=155 THEN CLEARGRAPHIC()¢   SGRAPHIC() SHOWXY()¢  FI¢ ELSEIF A='① THEN ;CTRL-Q¢  CLEARSLINE() PRINT8(2,2,¢  "    'ך' TO QUIT PROGRAM")¢  A=GETD(1)¢  IF A='Y THEN EXIT FI¢ ELSEIF A='L THEN¢  LMODE==+1 IF LMODE=3 THEN LMODE=0¢  FI¢  PN=0 TEXTURE=0¢ ELSEIF A='N THEN NEGATE()¢ ELSEIF A='
 THEN ;CTRL-M¢  CLEARSLINE() PRINT8(2,2,¢  "WHICH PATTERN(1 OR 2)?")¢  A=GETD(1)-48¢  IF A=1 OR A=2 THEN MOIRE(A) FI¢ ELSEIF A='     THEN INVERT() ;CTRL-I¢ ELSEIF A='Z THEN¢  CLEARSLINE()¢  PRINT8(6,2,"CURSOR SPEED>")¢  A=GETD(1)¢   IF A>='0 AND A<='9 THEN¢    SPEED=(A-48)*750 PUT8(33,14,A)¢   FI¢ ELSEIF A='◆ THEN LOAD() ;CTRL-G¢ ELSEIF A='③ THEN SAVE() ;CTRL-S¢ FI ¢ IF MOVE=0 AND A#0 THEN¢  STATLINE() SHOWSPECS()¢ FI¢OD¢RETURN¢¢PROC RESET=58484()¢;Leave program by warmstart¢¢PROC SETUP()¢CLOSE(1) OPEN(1,"K:",4,0) ERROR=MYERR¢CLEARGRAPHIC() MAIN() RESET()¢RETURN¢¢