**** ViewPort als ILBM abspeichern (1/1987) ****

   include "exec/types.i"
   include "intuition/intuition.i"

;   include  "IncludeFile"

xlib macro
   xref  _LVO\1
   endm

call  macro
   jsr   _LVO\1(a6)
   endm

   xref  _AbsExecBase
   xref  DosBase
   xdef  SaveVPort

   xlib  AllocMem
   xlib  FreeMem

   xlib  Open
   xlib  Close
   xlib  Write

SaveVPort:                     ;a0=*ViewPort,a1=*Name
   move.l   a1,FileName
   move.l   vp_ColorMap(a0),a2
   move.l   cm_ColorTable(a2),a2
   moveq    #31,d2
   lea      Colors,a3
ColLoop:
   move.w   (a2),d0
   lsr.w    #4,d0
   and.w    #$f0,d0
   move.b   d0,(a3)+
   move.w   (a2),d0
   and.w    #$f0,d0
   move.b   d0,(a3)+
   move.w   (a2)+,d0
   lsl.w    #4,d0
   move.b   d0,(a3)+
   dbf      d2,ColLoop

   move.l   vp_RasInfo(a0),a2
   move.l   ri_BitMap(a2),a2
   move.w   bm_BytesPerRow(a2),d0
   lsl.w    #3,d0
   move.w   d0,Width
   move.w   d0,RWidth
   move.w   bm_Rows(a2),d1
   move.w   d1,Height
   move.w   d1,RHeight
   move.b   bm_Depth(a2),Planes

   clr.l    BodySize
   clr.w    Counter

MainLoop:
   tst.w    Counter
   beq.s    NoAllocate
   move.l   _AbsExecBase,a6
   move.l   BodySize,d0
   addq.l   #8,d0
   moveq    #2,d1    ;MEMF_CHIP
   call     AllocMem
   move.l   d0,Buffer
   beq      Out
NoAllocate:

   clr.l    d5       ;BodySize
   move.l   Buffer,a4
   addq.l   #8,a4    ;BufferAddress
   clr.w    YCount
YLoop:
   clr.w    PlaneCount
PlaneLoop:
   move.w   PlaneCount,d3
   move.l   bm_Planes(a2,d3.w),a3
   move.w   Width,d3
   lsr.w    #3,d3
   move.w   d3,d2
   mulu     YCount,d2
   add.l    d2,a3
   moveq    #1,d1    ;XCount
   move.b   (a3),d2  ;XOld
   clr.l    d3       ;ByteCount
   clr.l    d4       ;RunFlag
XLoop:
   move.b   0(a3,d1),d0
   cmp.b    d2,d0
   bne      XDump
   tst.w    d4
   bne      Inc
DumpIt:
   tst.l    d3
   beq.s    DumpEnd
   add.l    d3,d5
   addq.l   #1,d5
   move.l   d3,d0
   subq.l   #1,d0
   cmp.b    #127,d0
   bhi      Error
   tst.w    Counter  ;Beim 1.mal nicht speichern
   beq.s    DumpEnd
   move.b   d0,(a4)+
   sub.l    d3,d1
DumpLoop:
   move.b   -1(a3,d1),(a4)+
   addq.l   #1,d1
   subq.l   #1,d3
   bne      DumpLoop
DumpEnd:
   not.w    d4
   moveq    #2,d3
   bra.s    CloseXLoop
XDump:
   tst.w    d4
   bne.s    RunIt
Inc:
   addq.l   #1,d3
   bra.s    CloseXLoop
RunIt:
   addq.l   #2,d5
   cmp.b    #127,d3
   bhi      Error
   neg.b    d3
   addq.b   #1,d3
   tst.w    Counter
   beq.s    NoStore
   move.b   d3,(a4)+
   move.b   d2,(a4)+
NoStore:
   clr.l    d3
   clr.w    d4
CloseXLoop:
   move.b   0(a3,d1),d2
   addq.l   #1,d1
   move.l   d1,d0
   lsl.w    #3,d0
   cmp.w    Width,d0
   blt      XLoop
   bgt.s    NoLast
   tst.w    d4
   bne      RunIt
   addq.l   #1,d3
   addq.l   #1,d1
   bra      DumpIt
NoLast:
   addq.w   #4,PlaneCount
   move.w   PlaneCount,d0
   lsr.w    #2,d0
   cmp.b    Planes,d0
   blt      PlaneLoop

   addq.w   #1,YCount
   move.w   YCount,d0
   cmp.w    Height,d0
   blt      YLoop

   addq.l   #3,d5
   and.w    #-4,d5
   move.l   d5,BodySize

   addq.w   #1,Counter
   cmp.w    #2,Counter
   blt      MainLoop

   move.l   DosBase,a6
   move.l   FileName,d1
   move.l   #1006,d2           ;MODE_NEWFILE
   call     Open
   move.l   d0,FileHandle
   beq.s    Error

   clr.l    d0
   move.b   Planes,d0
   moveq    #1,d1
   lsl.w    d0,d1
   mulu     #3,d1
   move.l   d1,ColorNum
   add.l    #HeaderLen,d1
   move.l   d1,d3
   add.l    BodySize,d1
   move.l   d1,FormLength
   move.l   FileHandle,d1
   move.l   #ILBMHeader,d2
   call     Write

   move.l   Buffer,a0
   move.l   #'BODY',(a0)+
   move.l   BodySize,(a0)
   move.l   FileHandle,d1
   move.l   Buffer,d2
   move.l   BodySize,d3
   addq.l   #8,d3
   call     Write

Error:
   move.l   FileHandle,d1
   beq.s    Free
   call     Close
Free:
   move.l   _AbsExecBase,a6
   move.l   Buffer,a1
   move.l   BodySize,d0
   beq.s    Out
   addq.l   #8,d0
   call     FreeMem
Out:
   moveq    #0,d0
   rts

   section ILBMdat,DATA

ILBMHeader: dc.l  'FORM'
FormLength: dc.l  0,'ILBM','BMHD',20
Width:      dc.w  0
Height:     dc.w  0,0,0
Planes:     dc.b  0,0,1,0,0,0,10,11
RWidth:     dc.w  0
RHeight:    dc.w  0
            dc.l  'CMAP'
ColorNum:   dc.l  96
HeaderLen   equ   *-ILBMHeader
Colors:     ds.b  96

   section ILBMmem,BSS

FileHandle: ds.l  1
XCount:     ds.w  1
YCount:     ds.w  1
PlaneCount: ds.w  1
Counter:    ds.w  1
BodySize:   ds.l  1
FileName:   ds.l  1
Buffer:     ds.l  1

   end