'************ PIC-a-PUT-PICTURE ****************
CLEAR,240000&
DEFINT a-j,x-z :DEFLNG k-m :DEFSTR t-w   

DIM kveld(5),brush(5123)

DECLARE FUNCTION xOpen&  LIBRARY
DECLARE FUNCTION xRead&  LIBRARY
DECLARE FUNCTION xWrite& LIBRARY
DECLARE FUNCTION AllocMem&() LIBRARY

LIBRARY "dos.library"
LIBRARY "exec.library"
LIBRARY "graphics.library"
LIBRARY "intuition.library"

start:
boptel=0  :mode=1 :verr="" :aw=0
PRINT 
LINE INPUT"FILENAME ? ";wpic
IF wpic="" THEN uitgang2
GOSUB tekening.laden
IF verr<>""THEN
 IF aw THEN 
  GOTO uitgang
 ELSE
  GOTO uitgang2
 END IF
END IF  
bepalen:
MOUSE ON
WHILE MOUSE(0)<>0 :WEND
COMPLEMENT
WHILE MOUSE(0)=0 
 xmuis=MOUSE(1) :ymuis=MOUSE(2)
LINE (xmuis,ymuis)-(xmuis+127,ymuis%+127),,b
LINE (xmuis,ymuis)-(xmuis+127,ymuis%+127),,b
WEND
 x1=xmuis :y1=ymuis
 x2=x1+127 :y2=y1+127
COMPLEMENT
IF x1>x2 THEN SWAP x1,x2
IF y1>y2 THEN SWAP y1,y2
GET (x1,y1)-(x2,y2),brush
boptel=boptel+1
IF boptel=1 THEN
 WINDOW 3,"",,0,2  
ELSE
 WINDOW 3 :CALL ActivateWindow&(WINDOW(7)) :CLS
 END IF
PUT (10,10),brush
LOCATE INT((y2-y1)/8)+4,2 :INPUT"THE RIGHT CUT (Y/N)";vv
IF vv="n" OR vv="N" THEN WINDOW 2 :CALL ActivateWindow&(WINDOW(7)):GOTO bepalen
LINE INPUT "FILENAME ";vv
OPEN vv FOR OUTPUT AS #1
FOR d=0 TO e
 WRITE #1,brush(d)
NEXT d
CLOSE #1 
OPEN vv FOR INPUT AS 2
 vlengte=INPUT$(LOF(2),2)
CLOSE 2 
 lengte=LEN(vlengte)
 blocks=INT(lengte/483) :IF blocks<>lengte/483 THEN blocks=blocks+1
CLS
PRINT 
PRINT vv :PRINT
PRINT"filelenght    ="+STR$(lengte)
PRINT"blocks        ="+STR$(blocks)
WHILE INKEY$="" :WEND

uitgang:
WINDOW CLOSE 2
SCREEN CLOSE 2 :
uitgang2:
MOUSE STOP :LIBRARY CLOSE :PRINT verr
END

SUB COMPLEMENT STATIC
SHARED mode
 IF (mode AND 2)=2 THEN mode=(mode AND 5) ELSE mode=mode+2
CALL SetDrMd& (WINDOW(8),mode)
END SUB

tekening.laden:

 kstart = 0 :mbuffer = 0
 atest1 = 0 :atest2 = 0 :atest3 = 0 :atest4 = 0 :atest5 = 0
 wpic= wpic + CHR$(0)
kstart = xOpen&(SADD(wpic),1005)
IF kstart = 0 THEN
   verr="FILE NOT FOUND" :GOTO wegwezen
END IF
 kschoon = 65537& :mbuf = 360
 mbuffer = AllocMem&(mbuf,kschoon)
IF mbuffer = 0 THEN
   verr="NOT ENOUGH MEMORIE TO CREATE BUFFERS" :GOTO wegwezen
END IF
 minbuffer = mbuffer :mcbuffer = mbuffer + 120 :mctabel = mbuffer + 240
 lengte = xRead&(kstart,minbuffer,12)
 thoofd = ""
FOR d = 8 TO 11
   ahoofd = PEEK(minbuffer + d)
   thoofd = thoofd + CHR$(ahoofd)
NEXT
IF thoofd <> "ACBM" THEN 
   verr="NOT A ACBM-FILE" :GOTO wegwezen
END IF

nog.een.keer:
 lengte = xRead&(kstart,minbuffer,8)
 mlengte = PEEKL(minbuffer + 4)
 thoofd = ""
 FOR d = 0 TO 3
    ahoofd = PEEK(minbuffer + d)
    thoofd = thoofd + CHR$(ahoofd)
 NEXT   
    
IF thoofd = "BMHD" THEN  
 atest1 = 1
 lengte = xRead&(kstart,minbuffer,mlengte)
 breedte1  = PEEKW(minbuffer)
 hoogte1 = PEEKW(minbuffer + 2)
 diepte1  = PEEK(minbuffer + 8)  
 compr  = PEEK(minbuffer + 10)
 breedte  = PEEKW(minbuffer + 16)
 hoogte = PEEKW(minbuffer + 18)

 bytes = breedte1 /8 :bytesscherm = breedte / 8 :aantkl  = 2^(diepte1)
 moeten = FRE(-1) :kmoet = ((breedte/8)*hoogte*(diepte1+1))+5000
   IF moeten < kmoet THEN
     verr="NOT ENOUGH MEMORIE TO CREATE SCREEN" :GOTO wegwezen
   END IF

   lhire = &H8000
   lace  = &H4
   d = 1
   IF atest3 THEN
      IF (lmode AND lhire) THEN d = d+1
      IF (lmode AND lace)  THEN d = d+2
   ELSE   
      IF breedte >= 640 THEN d = d + 1
      IF hoogte >= 400 THEN d = d + 2
   END IF
   SCREEN 2,breedte,hoogte,diepte1,d
   WINDOW 2,"CUTaPUZZLE",,16,2 :aw=-1
   GOSUB adressen
   CALL LoadRGB4&(kview,mctabel,aantkl)
   
ELSEIF thoofd = "CMAP" THEN  
   atest2 = 1
   lengte = xRead&(kstart,mcbuffer,mlengte)
   FOR d = 0 TO aantkl - 1
      cr = PEEK(mcbuffer+(d*3))
      cg = PEEK(mcbuffer+(d*3)+1)
      cb = PEEK(mcbuffer+(d*3)+2)
      czo = (cr*16)+(cg)+(cb/16)
      POKEW(mctabel+(2*d)),czo
   NEXT

ELSEIF thoofd = "CAMG" THEN 
   atest3 = 1
   lengte = xRead&(kstart,minbuffer,mlengte)
   lmode = PEEKL(minbuffer)

ELSEIF thoofd = "ABIT" THEN  
   atest5 = 1
   lgrootte = (breedte/8) * hoogte
   FOR e = 0 TO diepte1 -1
      lengte = xRead&(kstart,kveld(e),lgrootte)   
   NEXT

ELSE 
   FOR d = 1 TO mlengte
      lengte = xRead&(kstart,minbuffer,1)
   NEXT
   IF (mlengte OR 1) = mlengte THEN 
      lengte = xRead&(kstart,minbuffer,1)
   END IF
      
END IF
IF atest1 AND atest2 AND atest5 THEN
   GOTO goed.gedaan
END IF
IF lengte > 0 THEN GOTO nog.een.keer
IF lengte < 0 THEN  
   GOTO wegwezen
END IF   
IF (atest1=0) OR (atest5=0) OR (atest2=0) THEN
   GOTO wegwezen
END IF

goed.gedaan:
IF atest2 THEN 
   CALL LoadRGB4&(kview,mctabel,aantkl)
END IF

wegwezen:
IF kstart <> 0 THEN CALL xClose&(kstart)
IF mbuffer <> 0 THEN CALL FreeMem&(mbuffer,mbuf)
RETURN

adressen:
 kwin   = WINDOW(7)
 ksch   = PEEKL(kwin + 46)
 kview = ksch + 44
 kras = ksch + 84
 kleurmap = PEEKL(kview + 4)
 kleurtab  = PEEKL(kleurmap + 4)
 kbit   = PEEKL(kras + 4)
 breedte  = PEEKW(ksch + 12)
 hoogte = PEEKW(ksch + 14)
 diepte  = PEEK(kbit + 5)
 aantkl   = 2^diepte
FOR d = 0 TO diepte - 1
  kveld(d) = PEEKL(kbit+8+(d*4))
NEXT
RETURN