home *** CD-ROM | disk | FTP | other *** search
/ A.N.A.L.O.G. Magazine 1988 October / 88_oct.atr / pshopio.act < prev    next >
Text File  |  2023-02-26  |  5KB  |  1 lines

  1. ;IJגשIJמבדג PRINT SHOP GRAPHIC EDITOR¢;PRINT SHOP I/O SUBROUTINES    ¢;D:PSHOPIO.ACT¢;by ROBERT PLOTKIN¢; COPYRIGHT 1988 BY ANALOG COMPUTING¢;¢¢;      CHECKSUM DATA¢;[E0 CE 39 4E 5E 3E 3D CB ¢; CF 0F 25 FB 7A 77 B8 B2 ¢; C4 5C B2 CA 8C 84 95 41 ¢; 1D 98 A6 22 B8 ]¢¢MODULE¢¢BYTE KIND,PSFLAG,NAMENUM,EOPF,FOUND,¢     HKIND,STATUS=771,CB,CM,NLEN¢BYTE ARRAY BUFF(128),VTBUFF(128),¢     PSHOP(0)="PRINT SHOP:CLK!⇨",¢     FILE(32),NAME(32)¢CARD CURRDS,LASTDS,SSEC,NXSEC,CS¢BYTE POINTER NAMEP=NAME¢¢PROC SIO=$E453()¢¢PROC GKEY()¢POSITION(3,23) PRINT¢("ááááספדצצáIJמךáידךáקנáבנמקחמרדáááá")¢A=GETD(1)¢RETURN¢¢PROC SIOERR()¢POSITION(12,4)¢PRINT("②②>Disk Error<②②") GKEY()¢RETURN¢¢PROC DOSIO(BYTE CMD CARD ADR,SNUM)¢CARD SECBUF=772,SECNUM=778¢POKE(770,CMD) SECBUF=ADR SECNUM=SNUM¢POKE(769,1)¢SIO() IF STATUS#1 THEN SIOERR() FI¢RETURN¢¢PROC GETSECTOR(CARD SNUM,BUFADR)¢DOSIO('R,BUFADR,SNUM)¢RETURN¢¢PROC PUTSECTOR(CARD SNUM,BUFADR)¢DOSIO('P,BUFADR,SNUM)¢RETURN¢¢BYTE FUNC COMPARE(BYTE ARRAY S1,S2)¢BYTE LOOP,FLAG¢FLAG=1¢FOR LOOP=0 TO 15 DO¢ IF S1(LOOP)#S2(LOOP) THEN FLAG=0¢ FI¢OD¢RETURN(FLAG)¢¢PROC WHICH()¢BYTE BNUM,BIT¢GETSECTOR(361,VTBUFF)¢IF STATUS=1 THEN¢ PSFLAG=COMPARE(PSHOP+1,VTBUFF)¢ IF PSFLAG=1 THEN¢  LASTDS=361 BNUM=16 BIT=128¢  DO¢   IF (VTBUFF(BNUM)&BIT)=0 OR BNUM=31¢    THEN EXIT¢   FI BIT==RSH 1 LASTDS==+1¢   IF BIT=0 THEN BIT=128 BNUM==+1 FI¢  OD¢  IF LASTDS=361 THEN LASTDS=362 FI¢ ELSE POSITION(5,4) PRINT(¢  "THIS IS NOT A PRINT SHOP DISK!")¢  GKEY()¢ FI¢FI¢RETURN¢¢PROC OPENDIR()¢CURRDS=362 EOPF=0 NAMENUM=0¢GETSECTOR(362,BUFF)¢RETURN¢¢PROC GETNAME()¢DO¢ MOVEBLOCK(NAME,BUFF+NAMENUM,32)¢ NAMENUM==+32¢ IF NAMENUM=128 THEN NAMENUM=0¢  CURRDS==+1 GETSECTOR(CURRDS,BUFF)¢ FI KIND=NAME(18)¢IF CURRDS>LASTDS THEN EOPF=1 FI¢UNTIL NAMEP^#0 AND KIND=0 OR EOPF=1¢OD¢RETURN¢¢PROC PSFIND(BYTE ARRAY CNAME)¢FOUND=0¢DO GETNAME()¢IF COMPARE(NAME,CNAME)=1 THEN¢ SSEC=PEEKC(NAME+16) FOUND=1 EXIT¢FI IF EOPF=1 THEN EXIT FI¢OD¢RETURN¢¢PROC PSLOAD()¢BYTE POINTER POS¢BYTE COUNT¢WHICH() IF PSFLAG=0 THEN RETURN FI¢IF STATUS=1 THEN¢ OPENDIR() PSFIND(FILE)¢ IF FOUND=0 AND STATUS=1 THEN¢  POSITION(8,4) PRINT(¢  "②②>File Not Found<②②") GKEY()¢ FI¢FI¢IF FOUND=1 AND STATUS=1 THEN POS=GRPH¢ FOR COUNT=0 TO 4 DO¢  GETSECTOR(SSEC,POS)¢  SSEC=PEEKC(POS+126) POS==+126¢ OD¢FI¢RETURN¢¢PROC DALLOC(CARD SECNUM)¢BYTE BNUM,MASK,BIT¢A=SECNUM-362 BNUM=A RSH 3¢BIT=A-BNUM LSH 3 MASK=SQ(BIT)¢VTBUFF(BNUM+16)==%MASK¢RETURN¢¢PROC ALLOC(CARD SECNUM)¢BYTE BNUM,MASK,BIT¢BNUM=SECNUM RSH 3¢BIT=SECNUM-BNUM LSH 3 MASK=SQ(BIT)¢VTBUFF(BNUM+32)==%MASK¢RETURN¢¢CARD FUNC GETSSEC()¢DO¢ IF (VTBUFF(CB)&CM)=0 THEN RETURN(CS)¢ FI CS==+1 CM==RSH 1¢ IF CM=0 THEN CM=128 CB==+1 FI¢UNTIL CS=720¢OD¢RETURN(0)¢¢PROC DFULL()¢POSITION(5,4) PRINT¢("②②>Disk Full-Save Incomplete<②②")¢GKEY()¢RETURN¢¢PROC PSSAVE()¢CARD NXSEC¢BYTE POINTER POS¢CARD POINTER POS2¢CM=64 CS=1 CB=32¢WHICH() IF PSFLAG=0 THEN RETURN FI¢OPENDIR() PSFIND(FILE)¢IF FOUND=0 THEN¢ GETSECTOR(LASTDS,BUFF)¢ GETSECTOR(361,VTBUFF) NAMENUM=0¢ DO¢  IF BUFF(NAMENUM)=0 THEN EXIT FI¢  IF NAMENUM=128 THEN LASTDS==+1 EXIT¢  FI NAMENUM==+32¢ OD DALLOC(LASTDS)¢ IF NAMENUM=128 THEN ZERO(BUFF,128)¢ NAMENUM=0 FI¢ MOVEBLOCK(BUFF+NAMENUM,FILE,16)¢ NAMENUM==+16 SSEC=GETSSEC()¢IF SSEC=0 THEN DFULL() RETURN FI¢POKEC(BUFF+NAMENUM,SSEC) NAMENUM==+2¢BUFF(NAMENUM)=0 BUFF(NAMENUM+1)='X¢BUFF(NAMENUM+2)=60 BUFF(NAMENUM+3)=2¢PUTSECTOR(LASTDS,BUFF)¢FI¢POS=GRPH POS2=BUFF+126¢FOR I=1 TO 5 DO ALLOC(SSEC)¢ MOVEBLOCK(BUFF,POS,126)¢ NXSEC=GETSSEC()¢ IF NXSEC=0 THEN DFULL() EXIT FI¢ POS2^=NXSEC PUTSECTOR(SSEC,BUFF)¢ SSEC=NXSEC POS==+126¢OD PUTSECTOR(361,VTBUFF)¢RETURN¢¢PROC DIR()¢BYTE LM=82,LINE=84¢PUT(125) LM=12 POSITION(12,0) WHICH()¢IF PSFLAG=0 THEN RETURN FI OPENDIR()¢DO GETNAME()¢ IF KIND=0 AND NAMEP^#0 THEN¢  FOR K=0 TO 15 DO PUT(NAME(K)) OD¢  PUTE()¢ FI¢ IF EOPF=1 OR STATUS#1 THEN EXIT FI¢ IF LINE=23 THEN GKEY() PUT(125) FI¢OD GKEY()¢RETURN¢¢PROC GETFILE()¢BYTE LOOP¢NLEN=0¢DO A=GETD(1)¢ IF A=27 THEN NLEN=255 EXIT¢ ELSEIF A=155 THEN PUT(A)¢  IF NLEN=0 THEN DIR() FI EXIT¢ ELSEIF A=126 THEN¢  IF NLEN#0 THEN PUT(A) NLEN==-1 FI¢ ELSEIF NLEN#15 THEN¢  PUT(A) FILE(NLEN)=A NLEN==+1¢ FI¢OD¢FOR LOOP=NLEN TO 15 DO¢ FILE(LOOP)=32¢OD¢RETURN¢¢PROC INFILE(BYTE LTYPE)¢DO PUT(125) POKE(82,2)¢ POSITION(13,0)¢ IF LTYPE='L THEN¢  PRINT("áכנIJג")¢ ELSE PRINT("áצIJשד")¢ FI PRINT("áופIJסזחבá")¢ POSITION(2,10) PRINTE¢ ("TYPE IN NAME OF GRAPHIC OR")¢ PRINTE¢ ("PRESS <RETURN> FOR GRAPHIC LIST")¢ PRINTE("<ESC> TO EXIT") PUT('>)¢ GETFILE()¢ UNTIL NLEN#0¢OD¢RETURN¢¢PROC LOAD()¢GRAPHICS(0) INFILE('L)¢IF NLEN#255 THEN PSLOAD() FI¢DRAWSCREEN()¢RETURN¢¢PROC SAVE()¢GRAPHICS(0) INFILE('S)¢IF NLEN#255 THEN PSSAVE() FI¢DRAWSCREEN()¢RETURN¢¢