10 '                     P r e l i m i n a r i e s 
ON ERROR GOTO trap
LIBRARY "graphics.library"
LIBRARY "dos.library"
LIBRARY "exec.library"
DEFINT a-z
DEF FNarraysize&(W,H,P)=INT(3+2*(H+1)*INT((W+16)/16)*P/2)
DIM bPlane&(5)
DECLARE FUNCTION xOpen&  LIBRARY
DECLARE FUNCTION xRead&  LIBRARY
DECLARE FUNCTION AllocMem&() LIBRARY
 
'      L o o p s   b a c k   t o   h e r e   f o r   a n o t h e r
20 
SetPal 
COLOR 2,1:LOCATE 3,47:PRINT " (C/R to quit) "
LOCATE 2,47:INPUT " Name of Brush ",BrushName$

IF (BrushName$ = "") THEN CLS:COLOR 1,0:GOTO cleanup
objname$=BrushName$ + ".OBJ"

 '-----------------------------------------------
 '           T h e s e   a r e   t h e   h a r d   b i t s
 
 GOSUB LoadBrush

 GOSUB ObjectWork

 '-----------------------------------------------
 
   COLOR 2,1:LOCATE 10,47:PRINT " Now a Mouse Click will PUT "
   LOCATE 11,47:PRINT           " the image in any position. "
   dummy=MOUSE(0):WHILE MOUSE(0)=0:WEND
   WHILE MOUSE(0)<>0:x=MOUSE(1):y=MOUSE(2):WEND  
   PUT (x,y),BobArray,PSET
   LOCATE 12,47:PRINT " Click again to clear.      "
   dummy=MOUSE(0):WHILE MOUSE(0)=0:WEND
   WHILE MOUSE(0)<>0:WEND  
   ERASE BobArray
   COLOR 1,0:CLS
 GOTO 20            '      S o r r y   a b o u t   t h a t  GOTO              
  
cleanup:
 WINDOW CLOSE 2
 SCREEN CLOSE 2
 COLOR 1,0
 WINDOW CLOSE 1
 LIBRARY CLOSE
 SYSTEM
END
'====================================
'                 L O A D I N G 
'
'   This whole patch has been borrowed from Extras:LoadILBM-SaveACBM,
'   savagely distorted, hacked, and twisted.  There is still much in
'   it which I do not understand, and I suspect that many of the
'   details contribute nothing to the present program.

LoadBrush:
 f$ = BrushName$:fHandle& = 0:mybuf& = 0:foundBMHD = 0
 foundCMAP = 0:foundCAMG = 0:foundCCRT = 0:foundBODY = 0
 filename$ = f$ + CHR$(0)
 
 fHandle& = xOpen&(SADD(filename$),1005)
 IF fHandle& = 0 THEN Goof$ = "Can't open/find pic file": GOTO trap
 
 ClearPublic& = 65537&:mybufsize& = 360:mybuf& = AllocMem&(mybufsize&,ClearPublic&)
 IF mybuf& = 0 THEN Goof$ = "Can't alloc buffer": GOTO trap
 inbuf& = mybuf&:cbuf& = mybuf& + 120:ctab& = mybuf& + 240

 '--------- 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 Goof$ = "Not standard ILBM pic file": GOTO trap
 
'-----------------------------------
   '           L O O P
ChunkLoop:
 '--------- Get Chunk name/length
 
 rLen& = xRead&(fHandle&,inbuf&,8): icLen& = PEEKL(inbuf& + 4): tt$ = ""
 FOR kk = 0 TO 3:tt = PEEK(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)

   '----- Enough free ram to display ?
   AvailRam& = FRE(-1):NeededRam& = ((scrWidth/8)*scrHeight*(iDepth+1))+5000
   IF AvailRam& < NeededRam& THEN Goof$ = "Not enough free ram": GOTO trap

   kk = 1
   IF iDepth=1 THEN screed = 2 ELSE screed=iDepth
   SCREEN 2,scrWidth,scrHeight,screed,2
   WINDOW 2," Converting Brush to Object Image ",,,2
   COLOR 2,1:LOCATE 3,47:PRINT " Loading brush              "
   GOSUB GetScrAddrs

 ELSEIF tt$ = "CMAP" THEN  'ColorMap   
   foundCMAP = 1:   rLen& = xRead&(fHandle&,cbuf&,icLen&)

   '------- Palette details stored in temporary file
   
   OPEN "RAM:RGB" FOR OUTPUT AS #4
   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
      r!=red:g!=gre:b!=blu
      r!=r!/255:g!=g!/255:b!=b!/255
      PRINT #4,r!;",";g!;",";b!
   NEXT
   CLOSE #4
 ELSEIF tt$ = "CAMG" THEN  'Amiga ViewPort Modes
   foundCAMG = 1:rLen& = xRead&(fHandle&,inbuf&,icLen&):camgModes& = PEEKL(inbuf&)

 ELSEIF tt$ = "BODY" THEN  'BitMap 
   foundBODY = 1
  
   IF iCompr = 0 THEN  'no compression
     FOR rr = 10 TO iHeight + 9
       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 = 10 TO iHeight + 9
        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
      Goof$ = "Unknown compression algorithm":GOTO trap
   END IF

 ELSE 
   '----- 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
 IF foundBMHD AND foundCMAP AND foundBODY THEN GOTO GoodLoad
 IF rLen& > 0 THEN GOTO ChunkLoop

 IF rLen& < 0 THEN Goof$ = "Read error": GOTO trap
 IF (foundBMHD=0) OR (foundBODY=0) OR (foundCMAP=0) THEN
   Goof$ = "Needed ILBM chunks not found": GOTO trap
 END IF
 
GoodLoad:
 COLOR 2,1:LOCATE 4,47:PRINT " Loaded                     "
 Goof$ = ""
 
Lcleanup:
 IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
 IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
RETURN
  
GetScrAddrs:
  '----- 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)
  scrDepth  = PEEK(sBitMap& + 5): nColors = 2^scrDepth
  FOR kk = 0 TO scrDepth - 1:bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4)):NEXT   
RETURN
'--------------------------------------------------------------

'   Some of the following was borrowed from Extras:ObjEdit
 
ObjectWork:
  '             Lifts a copy of the loaded brush,
  '             saves it as an object file,
  '             then reloads that saved file.
  '
  '      I have had many problems with OBJECT.SHAPE and
  '      LOF(), and have avoided using them here.
  '
  '             The reloaded image can be placed at
  '             any position on the screen, using PUT
  '
  arraysize&=FNarraysize&(iWidth,iHeight,nColors-1)
  DIM BobArray(arraysize&)
  BobArray(0)=iWidth + 1
  BobArray(1)=iHeight + 1
  BobArray(2)=scrDepth
  GET (0,0)-(iWidth,iHeight),BobArray
   GOSUB SaveFile
   GOSUB LoadFile
  RETURN 
 
SaveFile:
  COLOR 2,1:LOCATE 5,47:PRINT " Saving as Object File      "
  LOCATE 7,47:PRINT "      PLEASE WAIT ....     "
  OPEN objname$ FOR OUTPUT AS 1
  PRINT #1, MKL$(0); 'ColorSet
  PRINT #1, MKL$(0); 'DataSet
  PRINT #1, MKI$(0);MKI$(BobArray(2)); 'depth
  PRINT #1, MKI$(0);MKI$(BobArray(0)); 'width
  PRINT #1, MKI$(0);MKI$(BobArray(1)); 'height
  PRINT #1, MKI$(24);
  PRINT #1, MKI$(nColors-1);  'planePick
  PRINT #1, MKI$(0);  'planeOnOff
  FOR i=3 TO arraysize&-1:PRINT #1, MKI$(BobArray(i));:NEXT
  CLOSE #1
 RETURN  

SUB SetPal STATIC
 PALETTE 0,.19,.5,.56: PALETTE 1,1,1,1
 PALETTE 2,0,0,0: PALETTE 3,.81,.69,.56
END SUB

trap:
  COLOR 1,0:IF Goof$<>"" THEN PRINT Goof$
  PRINT "Error ";ERR;" at line ";ERL:COLOR 1,0
  END

LoadFile:
'----------------------------------------------------------------
'   The following patch can be lifted out and used separately 
'   for just loading object files which already exist.  For
'   it to work on its own, each line which has been commented 
'   out with an initial apostrophe will need to have it removed.
'   One or two decorative details can also be removed.

' LIBRARY "graphics.library":DEFINT a-z
' DEF FNarraysize&(W,H,P)=INT(3+2*(H+1)*INT((W+16)/16)*P/2)
' INPUT " Name of Object (Program adds .OBJ) ",objname$
'   objname$=objname$+".obj"
'   PRINT "Loading"
   OPEN objname$ FOR INPUT AS 1
     d=CVL(INPUT$(4,1)):d=CVL(INPUT$(4,1))                      ' Not used
     Depth=CVL(INPUT$(4,1))
     BobRight=CVL(INPUT$(4,1))
     BobBottom=CVL(INPUT$(4,1))
     d=CVI(INPUT$(2,1)):d=CVI(INPUT$(2,1)):d=CVI(INPUT$(2,1))   ' Not used
'     arraysize&=FNarraysize&(BobRight-1,BobBottom-1,Depth)
'     DIM BobArray(arraysize&)
'     BobArray(0)=BobRight:BobArray(1)=BobBottom:BobArray(2)=Depth
     FOR i=3 TO arraysize&-1
       BobArray(i)=CVI(INPUT$(2,1))
     NEXT
   CLOSE #1
'   IF Depth > 2 THEN SCREEN 2,640,180,Depth,2:WINDOW 2,"",,,2
'   PUT (150,25),BobArray
'   IF Depth > 2 THEN
'     PRINT " Click to clear."
'     WHILE MOUSE(0)=0:WEND:WHILE MOUSE(0)<>0:WEND 
'     WINDOW CLOSE 2:SCREEN CLOSE 2
'   END IF  
' LIBRARY CLOSE
' END
'----------     End of patch which can be lifted out    -----------       

  LOCATE 9,47:PRINT " Fixing colours.            "
  OPEN "RAM:RGB" FOR INPUT AS 2
  FOR i = 0 TO nColors-1: INPUT #2,r!,g!,b!: PALETTE i,r!,g!,b!:NEXT
  CLOSE #2
RETURN