doc@pucc-j.UUCP (06/28/86)
Reply-To: ihnp4!cbmvax!carolyn@ecn (Carolyn Scheppner)
REM - SaveILBM
REM - by Carolyn Scheppner CBM 04/86
REM - This program saves a demo custom
REM - screen as an IFF ILBM file.
REM - (Graphicraft,Deluxe Paint, etc.)
REM - No icon is created for the file.
REM - If you need one, copy the .info
REM - file of a Graphicraft pic and
REM - call it filename.info
REM - Color cycling variables are
REM - saved as a Graphicraft CCRT
REM - chunk. The program could be
REM - modified to save color cycling
REM - information as DPaint CRNG
REM - chunks.
REM - Requires exec, graphics and dos
REM - .bmaps (Use NewConvertFD)
REM
Main:
PRINT "SaveILBM --- Saves a screen as an IFF ILBM file"
PRINT
PRINT " This program creates a demo screen and saves it as an"
PRINT "IFF ILBM pic file which can be loaded in Graphicraft,"
PRINT "DPaint, or Images. (For Images, add '.pic' to filename)"
PRINT
PRINT " Color cycling data is saved as a Graphicraft CCRT chunk."
PRINT "No icon is created for the save file. If you need one,"
PRINT "copy the .info file of one of your paint package's pics"
PRINT "and rename it to match the name of your saved pic file."
PRINT:PRINT
PRINT:PRINT "ENTER FILESPEC:"
PRINT "( Try Screen.ILBM )"
PRINT "( Enter <RETURN> for NO save file )"
PRINT
INPUT "FileSpec for ILBM save file";ILBMname$
PRINT
DIM bPlane&(5), cTabSave%(32)
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."
REM Custom Screen, some graphics
w = 320: h = 200: d = 5
AvailRam& = FRE(-1)
NeededRam& = ((w/8)*h*(d+1))+5000
IF AvailRam& < NeededRam& THEN
PRINT "Not enough free ram"
GOTO Mcleanup2
END IF
SCREEN 2,w,h,d,1
t$=" SaveILBM"
WINDOW 2,t$,,15,2
PALETTE 0,1,1,1
PALETTE 1,.2,.4,.8
REM - Get Screen structure addresses
GOSUB GetScrAddrs
REM - Init color cycling variables
REM - (Init to 0 for no cycling)
REM - These variables must be initialized
REM - because this version of SaveILBM
REM - always saves a Graphicraft CCRT chunk
ccrtDir% = 1
ccrtStart% = 1
ccrtEnd% = nColors% - 1
ccrtSecs& = 0
ccrtMics& = 2000
REM - Draw some lines to cycle
cReg = ccrtStart%
x = 20
FOR y = 0 TO 80
LINE (x,y)-(w-x-10,180-y),cReg,b
x = x + 1
cReg = cReg + 1: IF cReg > ccrtEnd% THEN cReg = ccrtStart%
NEXT
REM - Demo color cycling
REM - Save colors
FOR kk = 0 TO nColors% -1
cTabSave%(kk) = PEEKW(colorTab&+(kk*2))
NEXT
REM - Cycle colors
deSecs& = ccrtSecs& * 3000
deMics& = ccrtMics& / 500
cStart& = colorTab& + (2*ccrtStart%)
cEnd& = colorTab& + (2*ccrtEnd%)
repeat = 80
IF ccrtDir% = 1 THEN GOSUB Fcycle ELSE GOSUB Bcycle
REM - Restore colors
CALL LoadRGB4&(sViewPort&,VARPTR(cTabSave%(0)),nColors%)
REM - Save screen as ILBM file
IF (ILBMname$<>"") THEN
saveError$ = ""
GOSUB SaveILBM
END IF
Mcleanup:
FOR de = 1 TO 5000:NEXT
WINDOW CLOSE 2
SCREEN CLOSE 2
Mcleanup2:
LIBRARY CLOSE
IF saveError$ <> "" THEN PRINT saveError$
END
Fcycle:
FOR kk = 0 TO repeat
cTemp% = PEEKW(cStart&)
FOR jj& = cStart& + 2 TO cEnd& STEP 2
POKEW(jj&-2), PEEKW(jj&)
NEXT
POKEW cEnd&, cTemp%
CALL LoadRGB4&(sViewPort&,colorTab&,nColors%)
FOR d1& = 0 TO deSecs&
FOR d2& = 0 TO deMics&:NEXT
NEXT
NEXT
RETURN
Bcycle:
FOR kk = 0 TO repeat
cTemp% = PEEKW(cEnd&)
FOR jj& = cEnd& - 2 TO cStart& STEP -2
POKEW(jj&+2), PEEKW(jj&)
NEXT
POKEW(cStart&) = cTemp%
CALL LoadRGB4&(sViewPort&,colorTab&,nColors%)
FOR d1& = 0 TO deSecs&
FOR d2& = 0 TO deMics&:NEXT
NEXT
NEXT
RETURN
SaveILBM:
REM - Saves current window's screen
REM - as an IFF ILBM file with a
REM - Graphicraft CCRT cycling chunk.
REM - Requires the following variables
REM - to have been initialized:
REM - ILBMname$ (ILBM filespec)
REM - Also, cycling variables
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 - init variables
f$ = ILBMname$
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
BODYsize& = (scrWidth%/8) * scrHeight% * scrDepth%
REM - FORMsize& = Chunk sizes + 8 bytes per Chunk header + "ILBM"
FORMsize& = BMHDsize&+CMAPsize&+CAMGsize&+CCRTsize&+BODYsize&+44
REM - Write FORM header
tt$ = "FORM"
wLen& = xWrite&(fHandle&,SADD(tt$),4)
wLen& = xWrite&(fHandle&,VARPTR(FORMsize&),4)
tt$ = "ILBM"
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 BODY chunk
tt$ = "BODY"
wLen& = xWrite&(fHandle&,SADD(tt$),4)
wLen& = xWrite&(fHandle&,VARPTR(BODYsize&),4)
scrRowBytes% = scrWidth% / 8
FOR rr = 0 TO scrHeight% -1
FOR pp = 0 TO scrDepth% -1
scrRow& = bPlane&(pp)+(rr*scrRowBytes%)
wLen& = xWrite&(fHandle&,scrRow&,scrRowBytes%)
IF wLen& <= 0 THEN
saveError$ = "Error writing BODY"
GOTO Scleanup
END IF
NEXT
NEXT
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