langdon@lll-lcc.UUCP (02/07/87)
I have received requests for this program and it's not long, so here it is.
Also the MAC source for the file decoder routine.
----------------------------------------------------------------------
Bruce Langdon L-472 langdon@lll-lcc.ARPA
Physics Department "langdon#bruce%d@lll-mfe.ARPA"
Lawrence Livermore National Laboratory
Livermore, CA 94550 (415) 422-5444
UUCP: ..{ihnp4,qantel,ucdavis,pyramid,styx,topaz}!lll-lcc!langdon
..{gymble,ll-xn,seismo}!lll-crg!lll-lcc!langdon
----------------------------------------------------------------------
; MICROS.ACT
;
; READPIC - Reads MicroIllustrator
; picture files. Original code by
; Robert E. Wilson, REW Consulting.
;
; Modified for Action! and converted
; to code blocks by Harold Long,
; Bolton, MA. 14-Jan-1985
;
PROC GetByt=*() [
;Provides CCIO and bailout functions
$A5$AA$C5$AC$D0$06$A5$A9$C5$AB$F0$16
$A2$10$A9$00$8D$58$03$8D$59$03$20$56
$E4$30$09$E6$A9$D0$02$E6$AA$60$A9$01
$85$A0$68$68$60]
;Provides screen address canculation
PROC NxtPnt=*() [$24$A2$50$2C$C6$A5$F0
$0E$A9$50$18$65$A3$85$A3$A9$00$65$A4
$85$A4$60$A9$60$85$A5$C6$A6$F0$0E$A9
$28$18$65$AD$85$A3$A9$00$65$AE$85$A4
$60$A9$02$85$A6$A9$01$18$65$AD$85$AD
$85$A3$A9$00$65$AE$85$AE$85$A4$60]
;
BYTE FUNC READPIC=*() [
; Segment contains 181 bytes.
$A5$58$85$AD$85$A3$A5$59$85$AE$85$A4
$A9$60$85$A5$A9$02$85$A6$A9$07$8D$52
$03$A9$A0$8D$54$03$A9$00$8D$55$03$85
$A7$85$AC$A9$FF$85$AB$85$A9$85$AA$20
GetByt$85$A0$A5$A9$C9$07$F0$0A$C9$0C
$F0$10$C9$1A$F0$2B$D0$EB$A5$A0$4A$6A
$6A$85$A2$18$90$E1$A9$05$85$A1$20GetByt
$A6$A7$9D$C4$02$E6$A7$C6$A1$D0$F2
$20GetByt$85$AB$20GetByt$85$AC$18$90
$C2$A5$A2$F0$24$20GetByt$85$A1$29$7F
$D0$0F$20GetByt$85$A8$E6$A8$20GetByt
$85$A7$18$90$06$85$A7$A9$01$85$A8$A5
$A1$29$80$85$A1$20GetByt$85$A0$A0$00
$A5$A0$91$A3$20NxtPnt$A5$A2$F0$EE$C6
$A7$D0$04$C6$A8$F0$C2$A5$A1$F0$E9$D0
$E0]
;
; Build an ANTIC E mode display list
;
MODULE
BYTE SDMCTL=$22F, DINDEX=$57
CARD SDLSTL=$230
PROC ANTIC_E()
BYTE TEMP
CARD CHANGE
Graphics (8+16) ;Need GR 8
TEMP=Peek(SDMCTL) ;Save display control reg
Poke (SDMCTL, 0) ;Turn off display
Poke (SDLSTL+3,78) ;Force the first LMS
FOR CHANGE=(SDLSTL+6) TO (SDLSTL+204) ;WE KNOW HOW LONG MODE 8 IS
DO
IF Peek (CHANGE)=15 THEN
Poke (CHANGE, 14)
ELSEIF Peek (CHANGE)=79 THEN
Poke (CHANGE, 78)
FI
OD
Poke (DINDEX,7) ;Fool OS to think it's mode 7
Poke (SDMCTL, TEMP) ;Turn screen back on
RETURN
MODULE ;FILEHAN.ACT - General file and screen handler
; Copyright (c) 1984 Harold Long, Bolton MA
BYTE ARRAY fname(18) ;file name+ext
BYTE ARRAY infile(16),outfile(16)
BYTE FUNC IsLower(BYTE c)
IF (c>='a) AND (c<='z) THEN
RETURN(1)
FI
RETURN(0)
BYTE FUNC ToUpper(BYTE c)
IF IsLower(c) THEN
c ==- $20
FI
RETURN(c)
PROC Test_Name(BYTE POINTER fname)
BYTE chr, cnt, ext
BYTE ARRAY str132(24)
chr=0
ext=0
FOR cnt=1 TO fname(0) DO
fname(cnt)=ToUpper(fname(cnt))
IF fname(cnt)='. THEN ext=cnt FI
IF fname(cnt)=': THEN chr=1 FI
OD
IF (ext>0) AND (ext # (fname(0)-3)) THEN
fname(0)=ext+3
FI
IF chr=0 THEN
str132(0)=fname(0)+3
str132(1)='D
str132(2)='1
str132(3)=':
FOR cnt=1 TO fname(0) DO
str132(cnt+3)=fname(cnt) OD
FOR cnt=0 TO str132(0) DO
fname(cnt)=str132(cnt) OD
FI
RETURN
;
; Main shell routine
;
PROC Shell(BYTE ARRAY infile, outfile)
BYTE result
BYTE key=764
Close(1) ;for sure
Open(1,infile,4,0) ;open input
ANTIC_E() ;set up display list this way
;for all those poor 400/800
;owners...
result=READPIC()
Close(1)
DO
UNTIL key # 255
OD
key=255
RETURN
PROC Get_Files()
BYTE cnt
DO
Poke(82,1)
Put(125)
PutE()
PrintE("MICROS - MicroIllustrator Utilities.")
PrintE("Provides simple cut and paste")
PrintE("functions as demonstration routines.")
PrintE("Copyright (c) 1984 Harold Long")
PrintE("Permission granted to distribute for")
PrintE("non-commercial purposes.")
PutE()
Position(1,8)
PrintE("Input File? ")
Close(7)
Open(7,"K:",4,0)
DO
Position(13,8)
Put(' )
InputS(infile)
Test_Name(infile)
Position(13,8)
Print(" ")
Position(13,8)
Put(' )
Print(infile)
PutE()
PutE()
Print("Correct (Y/N)? ")
DO
cnt=GetD(7)
UNTIL cnt='Y OR cnt='y
OR cnt='N OR cnt='n OD
Put(cnt)
UNTIL cnt='Y OR cnt='y OD
PutE()
Shell(infile, outfile)
OD
RETURN
----------------------------------------------------------------------
TITLE'READPIC -- Reads ATARIARTIST Picture Files'
SUBTTL'Definitions'
;
;**** READPI.MAC -- Reads ATARIARTIST Picture Files ***
;
; By Robert Elden Wilson
; REW Consulting
; December, 1984
;
; *** Definitions ***
;
BYTE:EQU$CB;Will hold input byte
MODE:EQU$CC;Unique data or Same data mode
TYPE:EQU$CD;Compression type
PNT:EQU$CE;Buffer pointer
CNT96:EQU$D0;Counter (96-0)
CNT2:EQU$D1;Counter (2-0)
LEN:EQU$D4;Length of compression block
;
ICCMD:EQU$0352;IOCB1 command byte
ICBA:EQU$0354;IOCB1 buffer address
ICBL:EQU$0358;IOCB1 buffer length
;
SCRMEM:EQU$58;Address to Pointer to Screen memory
COLOR0:EQU$02C4;Playfield color 0 shadow
;
CIOV:EQU$E456;Address of CIO routine
;
;
EJECT
SUBTTL'Page Six'
;
; *** Page Six ***
;
;
; This block must be loaded into page 6.
;
ORG$0600
;
;
;>>>GETBYT --Inputs a byte from the file
;open on IOCB1. When number
;of bytes input equals
;value stored at LENGTH,
;return address is popped
;from stack and routine
;returns to previous caller.
;
GETBYT:LDACOUNT+1;See if done yet
CMPLENGTH+1
BNECONTIN;No, continue
LDACOUNT
CMPLENGTH
BEQERROR;Yes, exit
CONTIN:LDX#$10;Use IOCB1
LDA#$00;Set buffer len to 0
STAICBL;This causes byte
STAICBL+1;to be returned in A
JSRCIOV;Get byte
BMIERROR;Error
INCCOUNT;Increment # bytes read
BNEDONE
INCCOUNT+1
DONE:RTS;That's all
;
ERROR:PLA;Pop off return address
PLA
RTS;Return to previous caller
;
COUNT:DW0;# bytes input
LENGTH:DW0;Length of file
BASE:DW0;Base screen address
;
;
;>>>NXTPNT --Loads PNT with the screen
;address for the next byte
;of picture data.
;
NXTPNT:BITTYPE;Check compression type
BVCNOCOMP;No compression
DECCNT96;Have we done 96 rows?
BEQSTEP5;Yes
LDA#80;Add 80 to PNT
CLC
ADCPNT
STAPNT
LDA#$00
ADCPNT+1
STAPNT+1
RTS;Done
STEP5:LDA#96;Reset counter
STACNT96
DECCNT2;Both odd/even rows done?
BEQSTEP7;Yes
LDA#40;Add 40 to BASE
CLC
ADCBASE
STAPNT;and store in PNT
LDA#$00
ADCBASE+1
STAPNT+1
RTS;Done
STEP7:LDA#$02;Reset counter
STACNT2
NOCOMP:LDA#$01;Add 1 to BASE & PNT
CLC
ADCBASE
STABASE
STAPNT
LDA#$00
ADCBASE+1
STABASE+1
STAPNT+1
RTS;Done
;
EJECT
SUBTTL'Main Routine'
;
; *** Main Routine ***
;
;
; This block can be loaded anywhere.
;
ORG$0000
;
READIT:PLA;Remove arg cnt
LDASCRMEM;Get screen memory address
STABASE
STAPNT
LDASCRMEM+1
STABASE+1
STAPNT+1
LDA#96;Set up counters
STACNT96
LDA#$02
STACNT2
LDA#$07;I/O will be read
STAICCMD
LDA#BYTE;Store buffer address
STAICBA
LDA#$00
STAICBA+1
STALEN;Init remaining variables
STALENGTH+1
LDA#$FF
STALENGTH
STACOUNT
STACOUNT+1
READHD:JSRGETBYT;Get a header byte
STABYTE
LDACOUNT;Load # bytes read
CMP#$07
BEQCTYPE;Up to compression
CMP#$0C
BEQCOLORS;Up to colors
CMP#$1A
BEQREADAT;Done with header
BNEREADHD;Keep reading header
CTYPE:LDABYTE;Get data
LSRA;Move bits 0,1 to 6,7
RORA
RORA
STATYPE;Save compression type
CLC
BCCREADHD;Read more header
COLORS:LDA#$05;Load counter to read colors
STAMODE
NXTCOL:JSRGETBYT;Get a color
LDXLEN
STACOLOR0,X ;Store it
INCLEN
DECMODE
BNENXTCOL;Get next one
JSRGETBYT;Get file size
STALENGTH;Store it
JSRGETBYT
STALENGTH+1
CLC
BCCREADHD;Read more header
READAT:LDATYPE;Get compression type
BEQINPBYT;No compression
COMPR:JSRGETBYT;Get a mode byte
STAMODE
AND#$7F;Get count
BNESHORT;Count < 128
JSRGETBYT;Get long count
STALEN+1
INCLEN+1
JSRGETBYT
STALEN
CLC
BCCGETDAT
SHORT:STALEN
LDA#$01
STALEN+1
GETDAT:LDAMODE;Reload mode
AND#$80;Strip off count
STAMODE
INPBYT:JSRGETBYT;Get data byte
STABYTE
LDY#$00
STORE:LDABYTE
STA(PNT),Y;Store it
JSRNXTPNT;Go calculate next address
LDATYPE;Check compression
BEQINPBYT;No compression
DECLEN;More in the block?
BNENEXT;Yes
DECLEN+1
BEQCOMPR;No, get next mode byte
NEXT:LDAMODE;Check mode
BEQSTORE;Repeated data mode
BNEINPBYT;Unique data mode
;
END
-------------