start:
       move.l  #0,-(a7)       ; must be in supervisor mode
       move.w  #$20,-(a7)
       trap    #1
       adda.l  #6,a7
       move.l  d0,save_ptr
       move.w  #0,-(a7)       ; must be in low resolution
       move.l  #-1,-(a7)
       move.l  #-1,-(a7)
       move.w  #5,-(a7)
       trap    #14
       adda.l  #12,a7
       move.l  #pallete,-(a7) ; set pallete
       move.w  #6,-(a7)
       trap    #14
       adda.l  #6,a7
       move.l  #1520,skip_lines ; # lines to skip at top of screen

get_frame:
       movea.l #buff,a6       ; initialize pointers and status reg
       movea.l #$FA4000,a4    ; cartridge read location
       move.w  SR,save_sr     ; save status register
       move.w  #$2700,SR      ; turn off all interrupts
       move.w  #261,d4        ; line counter

find_vbl:
       move.w  #6,d1          ; counts # words=0
find_vbl1:
       move.w  (a4),d0        ; read interface
       bne     find_vbl       ; start over if not in sync area
       dbf     d1,find_vbl1   ; read zero - decrement counter
find_vbl2:
       move.w  (a4),d0        ; end of vert sync when
       beq     find_vbl2      ;  2 words <> 0 found
       move.w  (a4),d0
       beq     find_vbl2

capture:
       clr.w   d0             ; use to locate horizontal sync
capture1:
       cmp.b  (a4),d0         ; look for sync pulse
       bne     capture1
       move.w  (a4),(a6)+     ; capture 1 line as fast as possible
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+     ; 30
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+
       move.w  (a4),(a6)+     ; 38 x 5 = 190 pixels
       dbf     d4,capture

       move.w  save_sr,SR     ; restore interrupts

       movea.l #buff,a4       ; a4=base of captured data
       adda.l  skip_lines,a4  ; skip top lines
       movea.l a4,a5          ; a5=beginning of each line
       move.l  $44e,a3        ; a3=base of screen RAM
       move.w  #0,row         ; row counter range 0-199
       move.w  #200,d1        ; used to make sure a picture was grabbed
       cmpi.w  #0,quarter     ; quarter or full screen display?
       beq     decode
       add.w   #1,qcount      ; quarter screen - which one?
       adda.l  #80,a3
       cmpi.w  #1,qcount      ; branch if upper right
       beq     decode
       adda.l  #15920,a3
       cmpi.w  #2,qcount      ; branch if lower left
       beq     decode
       adda.l  #80,a3
       cmpi.w  #3,qcount      ; branch if lower right
       beq     decode
       movea.l $44e,a3        ; must be upper left
       move.w  #0,qcount      ; restore quarter counter
decode:
       subi.w  #1,d1          ; if searched too far...
       beq     checkkey       ; ...assume invalid frame
       move.w  (a4)+,d0       ; find end of horiz sync pulse
       beq     decode
       move.w  #4,d1          ; in this byte somewhere
       move.w  #7,d2          ; pixel counter
       move.w  #19,d7         ; counts screen word sets per line
       cmpi.w  #0,quarter     ; 1/4-screen display?
       beq     decodea
       move.w  #9,d7          ; yes - adjust counters accordingly
       move.w  #15,d2
decodea:
       swap    d0             ; set up d0 as work area
       clr.w   d0
       movea.l #avelist,a0    ; prepare lookup base location
decode1:
       lsr.l   #3,d0          ; shift off one pixel
       cmpi.w  #0,d0          ; is it the end of hblank?
       bne     decode1a
       dbf     d1,decode1     ; this should never fall through
       bra     decode         ; but, just in case...
decode1a:
       adda.l  #4,a4          ; skip over back porch
       move.w  (a4)+,d0       ; get word at end of back porch
       swap    d0
       clr.w   d0
       move.w  #5,d6          ; calculate shift for new word
decode1b:
       lsr.l   #3,d0          ; shift new word...
       subi.w  #1,d6          ; ...same amount...
       cmp.w   d6,d1          ; ...after back porch
       bne     decode1b
       andi.w  #$E000,d0      ; get rid of any leftover garbage
decode2:
       move.w  d0,d3          ; set word ready for shifting
       cmp.w   #0,quarter     ; quarter screen?
       bne     dquart
       cmp.w   #0,method      ; full screen - ave or double method?
       beq     decode2a
       andi.w  #$E000,d0
       rol.w   #3,d6          ; average pixel method
       or.w    d0,d6          ; encode two samples for lookup
       rol.w   #3,d6
       andi.w  #$003F,d6      ; mask off leftover bits
       move.b  (a0,d6),d6     ; look up averaged value
       ror.w   #3,d6          ; put new bits into proper position
       move.w  d6,d3          ; display averaged pixel
       move.w  d0,d6          ; tuck new byte to average next time
decode2a:
       add.l   d3,d3          ; shift 1 bit to first plane
       move.w  d3,d4
       add.l   d4,d4          ; shift next bit to plane 2
       move.w  d4,d5
       add.l   d5,d5          ; shift third bit to plane 3
dquart:
       move.w  d0,d3          ; display pixel
       add.l   d3,d3          ; shift for plane 1
       move.w  d3,d4
       add.l   d4,d4          ; shift for plane 2
       move.w  d4,d5
       add.l   d5,d5          ; shift for plane 3
       lsr.l   #3,d0          ; get next pixel
       dbf     d1,decode3     ; check for end of this byte
       clr.l   d0
       move.w  (a4)+,d0       ; done - get next byte
       move.w  #4,d1          ; reinitialize counter
       swap    d0             ; put value in upper 1/2
       lsr.l   #3,d0          ; rotate off first pixel
decode3:
       dbf     d2,decode2     ; check for end of screen word
       move.w  #8,d2          ; 7 if full screen, 15 if 1/4 screen
       and.w   quarter,d2     ; for samples per screen word set
       add.w   #7,d2
       swap    d4             ; shuffle words into position
       move.w  d4,d5
       clr.w   d3
       move.l  d5,(a3)+       ; save words to screen area
       move.l  d3,(a3)+
       dbf     d7,decode2     ; end of line?
       adda.l  #76,a5         ; go to next line on full screen...
       cmpi.w  #$0000,quarter
       beq     decode4
       adda.l  #76,a5         ; ...skip one line if 1/4 screen
       adda.l  #80,a3
       add.w   #1,row
decode4:
       movea.l a5,a4          ; set counter to beginning of line
       add.w   #1,row
       move.w  #200,d1        ; restore invalid frame counter
       cmpi.w  #200,row       ; check for end of display
       bne     decode         ; not at end - do next line
checkkey:
       move.w  #2,-(a7)       ; see if a keypress is waiting
       move.w  #1,-(a7)
       trap    #13
       adda.l  #4,a7
       cmpi.w  #$0000,d0
       beq     get_frame      ; get next if no keypress
       move.w  #2,-(a7)       ; else get the key
       move.w  #2,-(a7)
       trap    #13
       adda.l  #4,a7
       andi.w  #$001F,d0
       cmpi.w  #17,d0         ; q is quit
       beq     quit
       cmpi.w  #19,d0         ; s is save
       beq     saveit
       cmpi.w  #$1,d0         ; A=top (adjust skip_lines)
       beq     zeromask
       cmpi.w  #$2,d0         ; B=middle (adjust skip_lines)
       beq     onemask
       cmpi.w  #$3,d0         ; C=bottom (adjust skip_lines)
       beq     twomask
       cmpi.w  #4,d0
       beq     double         ; D = double pixels
       cmpi.w  #5,d0
       beq     average        ; E = average pixels
       cmpi.w  #6,d0
       beq     fullscreen     ; F = full screen display
       cmpi.w  #8,d0
       beq     halfscreen     ; H = half sized display
       bra     get_frame
zeromask:
       move.l  #1520,skip_lines ; for top 200 lines
       bra     get_frame
onemask:
       move.l  #2660,skip_lines ; for middle 200 lines
       bra     get_frame
twomask:
       move.l  #3800,skip_lines ; for bottom 200 lines
       bra     get_frame
double:
       move.w  #$0000,method    ; $0 is code for doubling method
       bra     get_frame
average:
       move.w  #$FFFF,method    ; code for averaging method
       bra     get_frame
fullscreen:
       move.w  #$0000,quarter   ; full screen display code = 0
       bra     get_frame
halfscreen:
       move.w  #$FFFF,quarter   ; quarter screen code is FFFF
       bra     get_frame
saveit:
       move.w  #0,-(a7)       ; open file for writing
       move.l  #filespec,-(a7)
       move.w  #$3C,-(a7)
       trap    #1
       adda.l  #8,a7
       move.w  d0,handle
       move.w  #0,nextcolor   ; write res + palette
       move.l  #nextcolor,-(a7)
       move.l  #34,-(a7)
       move.w  d0,-(a7)
       move.w  #$40,-(a7)
       trap    #1
       adda.l  #12,a7
       move.l  $44E,-(a7)     ; screen memory - write picture
       move.l  #32000,-(a7)
       move.w  handle,-(a7)
       move.w  #$40,-(a7)
       trap    #1
       adda.l  #12,a7
       move.w  handle,-(a7)   ; close file
       move.w  #$3E,-(a7)
       trap    #1
       adda.l  #4,a7
       add.b   #1,fletter     ; increment file name
       bra     get_frame

quit:
       move.w  #1,-(a7)       ; restore resolution
       move.l  #-1,-(a7)      ; note-this assumes medium res
       move.l  #-1,-(a7)
       move.w  #5,-(a7)
       trap    #14
       adda.l  #12,a7

       move.l  #oldpalet,-(a7) ; restore colors
       move.w  #6,-(a7)
       trap    #14
       adda.l  #6,a7

       move.w  #0,-(a7)       ; terminate process
       move.w  #$4C,-(a7)
       trap    #1             ; should never get past this
       move.l  d0,pallete+1   ; but if it does...

qcount:
       dc.w    $0000
quarter:
       dc.w    $0000
method:
       dc.w    $0000
skip_lines:
       dc.l    $00000000
scount:
       dc.w    $0000
nextcolor:
       dc.w    $0000
; Grey scaled pallette
;
; Note: The pallette and averaging table are configured for the
; Atari 1040 STe, which uses one extra bit to define each color.
; These will work on other ST's, but if you want to translate to
; the 3-bits per color used on the older systems, change 8 to 0,
; 9 to 1, etc., up to F to 7, ANDing each digit with 7.
;
pallete:
       dc.w    $0000,$0111,$0333,$0222,$0555,$0666,$0444,$0777
       dc.w    $0888,$0999,$0BBB,$0AAA,$0DDD,$0EEE,$0CCC,$0FFF
oldpalet:
       dc.w    $0777,$0700,$0070,$0000,$0007,$0005,$0520,$0000
       dc.w    $0555,$0222,$0077,$0055,$0707,$0505,$0770,$0311
avelist:
       dc.b    $00,$08,$09,$01,$0A,$02,$03,$0B
       dc.b    $08,$01,$03,$09,$02,$0A,$0B,$06
       dc.b    $09,$03,$02,$0B,$06,$0E,$0A,$04
       dc.b    $01,$09,$0B,$03,$0A,$06,$02,$0E
       dc.b    $0A,$02,$06,$0A,$04,$0C,$0E,$05
       dc.b    $02,$0A,$0E,$06,$0C,$05,$04,$0D
       dc.b    $03,$0B,$0A,$02,$0E,$04,$06,$0C
       dc.b    $0B,$06,$04,$0E,$05,$0D,$0C,$07
save_ptr:
       dc.l    $00000000
save_sr:
       dc.l    $00000000
filespec:
       dc.b    'PIC'
fletter:
       dc.b    'A.PI1'
handle:
       dc.w    $0000
row:   dc.w    $0000
       bss
buff:  ds.b    15200
blank: ds.b    100
       end