doc@pucc-j.UUCP (06/28/86)
Reply-To: ihnp4!cbmvax!carolyn@ecn (Carolyn Scheppner)
REM - LoadILBM-SaveACBM
REM - by Carolyn Scheppner CBM 04/86
REM - This program loads an IFF ILBM
REM - (Graphicraft,Deluxe Paint, etc.)
REM - into a custom screen/window.
REM - If a Graphicraft color cycling
REM - chunk (CCRT) is found, it will
REM - also demo the color cycling.
REM - If the user wishes, the screen
REM - is then saved in a file format
REM - (ACBM - Amiga Contiguous BitMap)
REM - which an AmigaBasic program can
REM - load more quickly. (LoadACBM)
REM - The ACBM form is similar to
REM - an ILBM form, except an ABIT
REM - chunk replaces the interleaved
REM - BODY chunk. ABIT contains
REM - sequential contiguous Amiga
REM - BitPlane data.
REM - Requires exec, graphics and dos
REM - .bmaps (Use NewConvertFD)
REM
Main:
PRINT "LoadILBM-SaveACBM --- ILBM loader and converter"
PRINT
PRINT " This program loads and displays an IFF ILBM pic file"
PRINT "(Graphicraft, DPaint, Images) and optionally saves it"
PRINT "in ACBM format (see comments for description)."
PRINT "ACBM files can be loaded more quickly from Basic."
PRINT
PRINT " Uncompacted ILBMs (Graphicraft) load fairly quickly but"
PRINT "compacted ILBMs (DPaint, Images) have long load times."
PRINT "Screen blanking during the load has been commented out"
PRINT "so the progress of the load can be monitored."
PRINT
DIM bPlane&(5), cTabWork%(32), cTabSave%(32)
REM - Must create cycling variables
REM - because this version of SaveACBM
REM - always saves a CCRT chunk
ccrtDir% = 0
ccrtStart% = 0
ccrtEnd% = 0
ccrtSecs& = 0
ccrtMics& = 0
REM - Functions from dos.library
DECLARE FUNCTION xOpen& LIBRARY
DECLARE FUNCTION xRead& LIBRARY
DECLARE FUNCTION xWrite& LIBRARY
DECLARE FUNCTION IoErr& LIBRARY
REM - xClose returns no value
REM - Functions from exec.library
DECLARE FUNCTION AllocMem&() LIBRARY
REM - FreeMem returns no value
PRINT:PRINT "Looking for bmaps ... ";
LIBRARY "dos.library"
LIBRARY "exec.library"
LIBRARY "graphics.library"
PRINT "found them."
PRINT:PRINT "ENTER FILESPECS:"
PRINT "( Try Heart.ILBM, MedRes.ILBM or HiRes.ILBM )"
PRINT "( To view ILBM without converting, enter <RET> for ACBM filespec )"
PRINT
GetNames:
INPUT " IFF ILBM filespec";ILBMname$
IF (ILBMname$ = "") GOTO Mcleanup2
INPUT " ACBM filespec";ACBMname$
PRINT
REM - Load the IFF ILBM pic
loadError$ = ""
GOSUB LoadILBM
IF loadError$ <> "" THEN GOTO Mcleanup
REM - Demo Graphicraft color cycling
IF foundCCRT AND ccrtDir% THEN
REM - Save colors
FOR kk = 0 TO nColors% -1
cTabSave%(kk) = PEEKW(colorTab&+(kk*2))
cTabWork%(kk) = cTabSave%(kk)
NEXT
REM - Cycle colors
FOR kk = 0 TO 80
IF ccrtDir% = 1 THEN
GOSUB Fcycle
ELSE
GOSUB Bcycle
END IF
CALL LoadRGB4&(sViewPort&,VARPTR(cTabWork%(0)),nColors%)
REM - Delays approximated
FOR de1 = 0 TO ccrtSecs& * 3000
FOR de2 = 0 TO ccrtMics& / 500
NEXT
NEXT
NEXT
REM - Restore colors
CALL LoadRGB4&(sViewPort&,VARPTR(cTabSave%(0)),nColors%)
END IF
REM - Save screen as ACBM file
IF (loadError$ = "") AND (ACBMname$<>"") THEN
saveError$ = ""
GOSUB SaveACBM
END IF
Mcleanup:
FOR de = 1 TO 20000:NEXT
WINDOW CLOSE 2
SCREEN CLOSE 2
Mcleanup2:
LIBRARY CLOSE
IF loadError$ <> "" THEN PRINT loadError$
IF saveError$ <> "" THEN PRINT saveError$
END
Bcycle: 'Backward color cycle
cTemp% = cTabWork%(ccrtEnd%)
FOR jj = ccrtEnd%-1 TO ccrtStart% STEP -1
cTabWork%(jj+1) = cTabWork%(jj)
NEXT
cTabWork%(ccrtStart%) = cTemp%
RETURN
Fcycle: 'Forward color cycle
cTemp% = cTabWork%(ccrtStart%)
FOR jj = ccrtStart%+1 TO ccrtEnd%
cTabWork%(jj-1) = cTabWork%(jj)
NEXT
cTabWork%(ccrtEnd%) = cTemp%
RETURN
LoadILBM:
REM - Requires the following variables
REM - to have been initialized:
REM - ILBMname$ (IFF filename)
REM - init variables
f$ = ILBMname$
fHandle& = 0
mybuf& = 0
foundBMHD = 0
foundCMAP = 0
foundCAMG = 0
foundCCRT = 0
foundBODY = 0
REM - From include/libraries/dos.h
REM - MODE_NEWFILE = 1006
REM - MODE_OLDFILE = 1005
filename$ = f$ + CHR$(0)
fHandle& = xOpen&(SADD(filename$),1005)
IF fHandle& = 0 THEN
loadError$ = "Can't open/find pic file"
GOTO Lcleanup
END IF
REM - Alloc ram for work buffers
ClearPublic& = 65537&
mybufsize& = 360
mybuf& = AllocMem&(mybufsize&,ClearPublic&)
IF mybuf& = 0 THEN
loadError$ = "Can't alloc buffer"
GOTO Lcleanup
END IF
inbuf& = mybuf&
cbuf& = mybuf& + 120
ctab& = mybuf& + 240
REM - Should read FORMnnnnILBM
rLen& = xRead&(fHandle&,inbuf&,12)
tt$ = ""
FOR kk = 8 TO 11
tt% = PEEK(inbuf& + kk)
tt$ = tt$ + CHR$(tt%)
NEXT
IF tt$ <> "ILBM" THEN
loadError$ = "Not standard ILBM pic file"
GOTO Lcleanup
END IF
REM - Read ILBM chunks
ChunkLoop:
REM - Get Chunk name/length
rLen& = xRead&(fHandle&,inbuf&,8)
icLen& = PEEKL(inbuf& + 4)
tt$ = ""
FOR kk = 0 TO 3
tt% = PEEKK(inbuf& + kk)
tt$ = tt$ + CHR$(tt%)
NEXT
IF tt$ = "BMHD" THEN 'BitMap header
foundBMHD = 1
rLen& = xRead&(fHandle&,inbuf&,icLen&)
iWidth% = PEEKW(inbuf&)
iHeight% = PEEKW(inbuf& + 2)
iDepth% = PEEK(inbuf& + 8)
iCompr% = PEEK(inbuf& + 10)
scrWidth% = PEEKW(inbuf& + 16)
scrHeight% = PEEKW(inbuf& + 18)
iRowBytes% = iWidth% /8
scrRowBytes% = scrWidth% / 8
nColors% = 2^(iDepth%)
REM - Enough free ram to display ?
AvailRam& = FRE(-1)
NeededRam& = ((scrWidth%/8)*scrHeight%*(iDepth%+1))+5000
IF AvailRam& < NeededRam& THEN
loadError$ = "Not enough free ram"
GOTO Lcleanup
END IF
kk = 1
IF scrWidth% > 320 THEN kk = kk + 1
IF scrHeight% > 200 THEN kk = kk + 2
SCREEN 2,scrWidth%,scrHeight%,iDepth%,kk
WINDOW 2,"LoadILBM-SaveACBM",,15,2
REM - Get addresses of structures
GOSUB GetScrAddrs
REM - Black out screen
REM CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
ELSEIF tt$ = "CMAP" THEN 'ColorMap
foundCMAP = 1
rLen& = xRead&(fHandle&,cbuf&,icLen&)
REM - Build Color Table
FOR kk = 0 TO nColors% - 1
red% = PEEK(cbuf&+(kk*3))
gre% = PEEK(cbuf&+(kk*3)+1)
blu% = PEEK(cbuf&+(kk*3)+2)
regTemp% = (red%*16)+(gre%)+(blu%/16)
POKEW(ctab&+(2*kk)),regTemp%
NEXT
ELSEIF tt$ = "CAMG" THEN 'Amiga ViewPort Modes
foundCAMG = 1
rLen& = xRead&(fHandle&,inbuf&,icLen&)
camgModes& = PEEKL(inbuf&)
ELSEIF tt$ = "CCRT" THEN 'Graphicraft color cycle info
foundCCRT = 1
rLen& = xRead&(fHandle&,inbuf&,icLen&)
ccrtDir% = PEEKW(inbuf&)
ccrtStart% = PEEK(inbuf& + 2)
ccrtEnd% = PEEK(inbuf& + 3)
ccrtSecs& = PEEKL(inbuf& + 4)
ccrtMics& = PEEKL(inbuf& + 8)
ELSEIF tt$ = "BODY" THEN 'BitMap
foundBODY = 1
IF iCompr% = 0 THEN 'no compression
FOR rr = 0 TO iHeight% -1
FOR pp = 0 TO iDepth% -1
scrRow& = bPlane&(pp)+(rr*scrRowBytes%)
rLen& = xRead&(fHandle&,scrRow&,iRowBytes%)
NEXT
NEXT
ELSEIF iCompr% = 1 THEN 'cmpByteRun1
FOR rr = 0 TO iHeight% -1
FOR pp = 0 TO iDepth% -1
scrRow& = bPlane&(pp)+(rr*scrRowBytes%)
bCnt% = 0
WHILE (bCnt% < iRowBytes%)
rLen& = xRead&(fHandle&,inbuf&,1)
inCode% = PEEK(inbuf&)
IF inCode% < 128 THEN
rLen& = xRead&(fHandle&,scrRow& + bCnt%, inCode%+1)
bCnt% = bCnt% + inCode% + 1
ELSEIF inCode% > 128 THEN
rLen& = xRead&(fHandle&,inbuf&,1)
inByte% = PEEK(inbuf&)
FOR kk = bCnt% TO bCnt% + 257 - inCode%
POKE(scrRow&+kk),inByte%
NEXT
bCnt% = bCnt% + 257 - inCode%
END IF
WEND
NEXT
NEXT
ELSE
loadError$ = "Unknown compression algorithm"
GOTO Lcleanup
END IF
ELSE
REM - Reading unknown chunk
FOR kk = 1 TO icLen&
rLen& = xRead&(fHandle&,inbuf&,1)
NEXT
REM - If odd length, read 1 more byte
IF (icLen& OR 1) = icLen& THEN
rLen& = xRead&(fHandle&,inbuf&,1)
END IF
END IF
REM - Done if got all chunks
IF foundBMHD AND foundCMAP AND foundBODY THEN
GOTO GoodLoad
END IF
REM - Good read, get next chunk
IF rLen& > 0 THEN GOTO ChunkLoop
IF rLen& < 0 THEN 'Read error
loadError$ = "Read error"
GOTO Lcleanup
END IF
REM - rLen& = 0 means EOF
IF (foundBMHD=0) OR (foundBODY=0) OR (foundCMAP=0) THEN
loadError$ = "Needed ILBM chunks not found"
GOTO Lcleanup
END IF
GoodLoad:
loadError$ = ""
REM Load proper Colors
IF foundCMAP THEN
CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
END IF
Lcleanup:
IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
RETURN
SaveACBM:
REM - Saves current window's screen
REM - Requires the following variables
REM - to have been initialized:
REM - ACBMname$ (ACBM filespec)
REM - Also, if cycling info is to be stored
REM - ccrtDir% (1,-1, or 0 = none)
REM - ccrtStart% (low cycle reg)
REM - ccrtEnd% (high cycle reg)
REM - ccrtSecs& (cycle time in seconds)
REM - ccrtMics& (cycle time in microseconds)
REM
REM
REM - Format of ACBM file:
REM - LONG "FORM"
REM - LONG size of rest of file
REM - LONG "ACBM" (form type)
REM
REM - LONG "BMHD" (std IFF BitMap header chunk)
REM - LONG size of BMHD chunk = 20
REM - UWORD w (bitmap width in pixels)
REM - UWORD h (bitmap height)
REM - WORD x (nw corner) = 0
REM - WORD y (nw corner) = 0
REM - UBYTE nPlanes
REM - UBYTE masking = 0
REM - UBYTE compression = 0
REM - UBYTE pad1 = 0
REM - UWORD transparentColor = 0
REM - UBYTE xAspect (pixel) = 10
REM - UBYTE yAspect (pixel) = 11
REM - WORD pageWidth (screen width in pixels)
REM - WORD pageHeight (screen height in pixels)
REM
REM - LONG "CMAP" (std IFF ColorMap chunk)
REM - LONG size of CMAP chunk
REM - UBYTE Sets of 3 UBYTES (red, green, blue)
REM - (2^nPlanes sets)
REM - (rgb values LEFT justified in each UBYTE)
REM
REM - LONG "CAMG" (Amiga ViewPort Modes)
REM - LONG size of CAMG chunk
REM - LONG Mode
REM
REM - LONG "CCRT" (Graphicraft color cycle info)
REM - WORD direction (1,-1, or 0 = none)
REM - UBYTE start (low cycle reg)
REM - UBYTE end (high cycle reg)
REM - LONG seconds (cycle time)
REM - LONG microseconds (cycle time)
REM - WORD pad = 0
REM
REM (Amiga bitplanes 0, 1, etc)
REM - LONG "ABIT"
REM - LONG size of ABIT chunk
REM - BitPlanes 0 thru nPlanes - 1
REM - (each is h * (w/8) bytes)
REM - init variables
f$ = ACBMname$
fHandle& = 0
mybuf& = 0
filename$ = f$ + CHR$(0)
fHandle& = xOpen&(SADD(filename$),1006)
IF fHandle& = 0 THEN
saveError$ = "Can't open output file"
GOTO Scleanup
END IF
REM - Alloc ram for work buffers
ClearPublic& = 65537&
mybufsize& = 120
mybuf& = AllocMem&(mybufsize&,ClearPublic&)
IF mybuf& = 0 THEN
saveError$ = "Can't alloc buffer"
GOTO Scleanup
END IF
cbuf& = mybuf&
REM - Get addresses of screen structures
GOSUB GetScrAddrs
zero& = 0
pad% = 0
aspect% = &HA0B
REM - Compute chunk sizes
BMHDsize& = 20
CMAPsize& = (2^scrDepth%) * 3
CAMGsize& = 4
CCRTsize& = 14
ABITsize& = (scrWidth%/8) * scrHeight% * scrDepth%
REM - FORMsize& = Chunk sizes + 8 bytes per Chunk header + "ACBM"
FORMsize& = BMHDsize&+CMAPsize&+CAMGsize&+CCRTsize&+ABITsize&+44
REM - Write FORM header
tt$ = "FORM"
wLen& = xWrite&(fHandle&,SADD(tt$),4)
wLen& = xWrite&(fHandle&,VARPTR(FORMsize&),4)
tt$ = "ACBM"
wLen& = xWrite&(fHandle&,SADD(tt$),4)
IF wLen& <= 0 THEN
saveError$ = "Error writing FORM header"
GOTO Scleanup
END IF
REM - Write out BMHD chunk
tt$ = "BMHD"
wLen& = xWrite&(fHandle&,SADD(tt$),4)
wLen& = xWrite&(fHandle&,VARPTR(BMHDsize&),4)
wLen& = xWrite&(fHandle&,VARPTR(scrWidth%),2)
wLen& = xWrite&(fHandle&,VARPTR(scrHeight%),2)
wLen& = xWrite&(fHandle&,VARPTR(zero&),4)
temp% = (256 * scrDepth%)
wLen& = xWrite&(fHandle&,VARPTR(temp%),2)
wLen& = xWrite&(fHandle&,VARPTR(zero&),4)
wLen& = xWrite&(fHandle&,VARPTR(aspect%),2)
wLen& = xWrite&(fHandle&,VARPTR(scrWidth%),2)
wLen& = xWrite&(fHandle&,VARPTR(scrHeight%),2)
IF wLen& <= 0 THEN
saveError$ = "Error writing BMHD"
GOTO Scleanup
END IF
REM - Write CMAP chunk
tt$ = "CMAP"
wLen& = xWrite&(fHandle&,SADD(tt$),4)
wLen& = xWrite&(fHandle&,VARPTR(CMAPsize&),4)
REM - Build IFF ColorMap
FOR kk = 0 TO nColors% - 1
regTemp% = PEEKW(colorTab& + (2*kk))
POKE(cbuf&+(kk*3)),(regTemp% AND &HF00) / 16
POKE(cbuf&+(kk*3)+1),(regTemp% AND &HF0)
POKE(cbuf&+(kk*3)+2),(regTemp% AND &HF) * 16
NEXT
wLen& = xWrite&(fHandle&,cbuf&,CMAPsize&)
IF wLen& <= 0 THEN
saveError$ = "Error writing CMAP"
GOTO Scleanup
END IF
REM - Write CAMG chunk
tt$ = "CAMG"
wLen& = xWrite&(fHandle&,SADD(tt$),4)
wLen& = xWrite&(fHandle&,VARPTR(CAMGsize&),4)
vpModes& = PEEKW(sViewPort& + 32)
wLen& = xWrite&(fHandle&,VARPTR(vpModes&),4)
IF wLen& <= 0 THEN
saveError$ = "Error writing CAMG"
GOTO Scleanup
END IF
REM - Write CCRT chunk
tt$ = "CCRT"
wLen& = xWrite&(fHandle&,SADD(tt$),4)
wLen& = xWrite&(fHandle&,VARPTR(CCRTsize&),4)
wLen& = xWrite&(fHandle&,VARPTR(ccrtDir%),2)
temp% = (256*ccrtStart%) + ccrtEnd%
wLen& = xWrite&(fHandle&,VARPTR(temp%),2)
wLen& = xWrite&(fHandle&,VARPTR(ccrtSecs&),4)
wLen& = xWrite&(fHandle&,VARPTR(ccrtMics&),4)
wLen& = xWrite&(fHandle&,VARPTR(pad%),2)
IF wLen& <= 0 THEN
saveError$ = "Error writing CCRT"
GOTO Scleanup
END IF
REM - Write ABIT chunk, bitplanes
tt$ = "ABIT"
wLen& = xWrite&(fHandle&,SADD(tt$),4)
wLen& = xWrite&(fHandle&,VARPTR(ABITsize&),4)
bpLen& = (scrWidth% / 8) * scrHeight%
FOR pp = 0 TO scrDepth% -1
wLen& = xWrite&(fHandle&,bPlane&(pp),bpLen&)
IF wLen& <= 0 THEN
saveError$ = "Error writing bit plane"+STR$(pp)
GOTO Scleanup
END IF
NEXT
GoodSave:
saveError$ = ""
Scleanup:
IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
RETURN
GetScrAddrs:
REM - Get addresses of screen structures
sWindow& = WINDOW(7)
sScreen& = PEEKL(sWindow& + 46)
sViewPort& = sScreen& + 44
sRastPort& = sScreen& + 84
sColorMap& = PEEKL(sViewPort& + 4)
colorTab& = PEEKL(sColorMap& + 4)
sBitMap& = PEEKL(sRastPort& + 4)
REM - Get screen parameters
scrWidth% = PEEKW(sScreen& + 12)
scrHeight% = PEEKW(sScreen& + 14)
scrDepth% = PEEK(sBitMap& + 5)
nColors% = 2^scrDepth%
REM - Get addresses of Bit Planes
FOR kk = 0 TO scrDepth% - 1
bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
NEXT
RETURN