;+asm
;add lkopt SC
;do
;*
;
; ### WeatherSatelliteReceiver by JM v 1.00 ###
;
; - Created 910523 by JM -
;
;
; Usage:
;	sat [buf_siz]
;
;	where buf_siz is the raw buffer size (default 16384).
;
;
; Bugs: Hmm.  If you ask me, the hardware itself is a big bug.
;
;
; Edited:
;
; - 910523 by JM -> v0.01	- code from uBDitigizer.      | One year since.. |
; - 910524 by JM -> v0.02	- Opens a screen and a window.
; - 910525..910529		- Lots of modifications, it works now.
; - 910530 by JM -> v1.00	- All commands finished, code crunched and tested.
;				- Uses a command table instead of several cmp.b's.
;


		include	"bb.i"
		include	"exec/types.i"
		include	"exec/execbase.i"
		include	"exec/tasks.i"
		include	"exec/nodes.i"
		include	"exec/memory.i"
		include	"exec/io.i"
		include	"exec/strings.i"
		include	"exec/interrupts.i"
		include	"exec/initializers.i"
		include	"hardware/intbits.i"
		include	"hardware/cia.i"
		include	"exec/interrupts.i"
		include	"intuition/intuition.i"
		include	"com.i"
		include	"relative.i"
		include	"util.i"
		include	"macros.i"
;		include	"constants.i"
		include	"hards.i"

		XREF	_LVOSetICR
		XREF	_LVOAbleICR
		XREF	_LVOAddICRVector
		XREF	_LVORemICRVector

_LVOAllocMiscResource	equ	-6
_LVOFreeMiscResource	equ	-12
MR_PARALLELPORT	equ	2

userport	equ	$bfe101
datadir		equ	$bfe301
timerl		equ	$bfd400
timerh		equ	$bfd500
tcontrol	equ	$bfde00
tint		equ	$bfdd00

HUGEMEM		equ	1000000000		-- never to be available --

ROWS		equ	512
BYTESPERROW	equ	40

		.var	global
		dlibb	Gfx,Intuition
		dlibb	MiscRes,CIA
		dl	DATA,data
		dl	screen,window,begbuf,bufpoi,modulo
		db	parport,int

		.local
		.begin
		ra
		moveq	#0,d2			; result
=numlp		moveq	#0,d0
		move.b	(a0)+,d0
		sub.b	#'0',d0
		blo.s	=numgot
		cmp.b	#'9',d0
		bhi.s	=numgot
		add.l	d2,d2			; d2 = old * 2
		move.l	d2,d1			; d1 = old * 2
		add.l	d2,d2			; d2 = old * 4
		add.l	d2,d2			; d2 = old * 8
		add.l	d1,d2			; d2 = old * 10
		add.l	d0,d2			; d2 = old * 10 + new
		bra.s	=numlp
=numgot		openlib	Gfx,=cleanup
		openlib	Intuition,=cleanup

		move.l	#16384,d0
		cmp.l	d0,d2
		blo.s	=numerr			; not a valid buffer size
		move.l	d2,d0
=numerr		move.l	d0,DATA			; save buffer size

		moveq	#103,d7			; out of memory
		move.l	#MEMF_PUBLIC,d1
		call	AllocMem
		move.l	d0,data
		beq	=cleanup
		move.l	d0,a0
		move.l	a0,begbuf
		move.l	DATA,a2
		subq.l	#4,a2
		add.l	a0,a2			; end address
		moveq	#0,d5			; start from color #0
patloop0	moveq	#15,d4
patloop1	moveq	#19,d3
		move.l	d5,d0			; color
patloop2	moveq	#15,d2
patloop3	move.b	d0,(a0)+		; put 16 bytes of the same color
		cmp.l	a2,a0
		bhs	pattern_ok
		dbf	d2,patloop3
		add.w	#16,d0			; change color
		dbf	d3,patloop2
		dbf	d4,patloop1
		add.w	#16,d5
		bra	patloop0

pattern_ok	move.w	#202,d7			; cant get parallel port
		bsr	allocparallel
		bne	=cleanup

		moveq	#0,d0
		lea	nscreen(pc),a1
		lea	NS,a2
		call	InitStruct

		moveq	#104,d7			; cannot OpenScreen()
		move.l	a2,a0
		call	OpenScreen
		move.l	d0,screen
		beq	=cleanup
		move.l	d0,a2
		lea	sc_ViewPort(a2),a0
		lea	colors(pc),a1
		moveq	#16,d0
		call	LoadRGB4

		moveq	#106,d7			; cannot OpenWindow()
		moveq	#0,d0
		lea	nwindow(pc),a1
		lea	NW,a2
		call	InitStruct
		move.l	a2,a0
		move.l	screen,nw_Screen(a0)
		call	OpenWindow
		move.l	d0,window
		beq	=cleanup

		move.l	#(BYTESPERROW*8*256),modulo

		moveq	#127,d7
		bsr	allocint
		bne	=cleanup

=waitloop	bsr	geti
		bmi	=away
		beq	=waitloop
		tst.b	d0
		bmi	=waitloop		; key UP

=handle		lea	=cmdtable(pc),a2	; RAW.B, QUAL.B, ADR.W
=handlecmp	move.b	(a2)+,d2		; get rawkey code
		beq.s	=waitloop		; not found
		cmp.b	d2,d0			; entry = key pressed?
		beq.s	=handlefnd		; yep -> check qualifier
		addq.l	#3,a2			; nope -> next entry
		bra.s	=handlecmp
=handlefnd	move.b	(a2)+,d2		; get qualifier from table
		beq.s	=handledoit		; zero -> don't care, do it
		and.b	d1,d2			; non-zero: perform and
		bne.s	=handledoit		; yep, go do it
		addq.l	#2,a2			; nope, try next one
		bra.s	=handlecmp
=handledoit	moveq	#0,d2			; clear d2
		add.w	(a2),a2			; get jump address
		jmp	(a2)

=cmdtable	dc.b	$45,0			; ESC
		dptr	=away
		dc.b	$22,0			; D
		dptr	=Cdigi
		dc.b	$4f,IEQUALIFIER_LSHIFT!IEQUALIFIER_RSHIFT ; shift left
		dptr	=CSleft
		dc.b	$4e,IEQUALIFIER_LSHIFT!IEQUALIFIER_RSHIFT ; shift right
		dptr	=CSright
		dc.b	$2d,IEQUALIFIER_LSHIFT!IEQUALIFIER_RSHIFT ; shift num4
		dptr	=CSnum4
		dc.b	$2f,IEQUALIFIER_LSHIFT!IEQUALIFIER_RSHIFT ; shift num 6
		dptr	=CSnum6
		dc.b	$2e,IEQUALIFIER_LSHIFT!IEQUALIFIER_RSHIFT ; shift num 5
		dptr	=CSnum5
		dc.b	$2d,IEQUALIFIER_LALT!IEQUALIFIER_RALT	  ; alt num 4
		dptr	=CAnum4
		dc.b	$2f,IEQUALIFIER_LALT!IEQUALIFIER_RALT	  ; alt num 6
		dptr	=CAnum6
		dc.b	$4c,IEQUALIFIER_LSHIFT!IEQUALIFIER_RSHIFT ; shift up
		dptr	=CSup
		dc.b	$4d,IEQUALIFIER_LSHIFT!IEQUALIFIER_RSHIFT ; shift down
		dptr	=CSdown
		dc.b	$4c,IEQUALIFIER_LALT!IEQUALIFIER_RALT	  ; alt up
		dptr	=Creset
		dc.b	$4d,IEQUALIFIER_LALT!IEQUALIFIER_RALT	  ; alt down
		dptr	=Creset

		dc.b	$4c,0			; cursor up
		dptr	=Cup
		dc.b	$4d,0			; cursor down
		dptr	=Cdown
		dc.b	$4f,0			; cursor left
		dptr	=Cleft
		dc.b	$4e,0			; cursor right
		dptr	=Cright
		dc.b	$2d,0			; numeric pad 4
		dptr	=Cnum4
		dc.b	$2f,0			; numeric pad 6
		dptr	=Cnum6
		dc.b	$2e,0			; numeric pad 5
		dptr	=Cnum5
		dc.b	$40,0			; space
		dptr	=Cspace
		dc.w	0

=CSright	moveq	#31,d2			; step = 32 pixels
=Cright		addq.l	#1,d2			; step =  1 pixel
		bra.s	=startadr
=CSleft		moveq	#-31,d2			; step = -32 pixels
=Cleft		subq.l	#1,d2			; step =  -1 pixel
=startadr	move.l	begbuf,d1
		add.l	d2,d1
		cmp.l	data,d1
		bhs.s	=starta_ok
		move.l	data,d1			; set to data if too low
=starta_ok	move.l	d1,begbuf
=Cspace		bsr	convert
		bmi	=away
		beq	=waitloop
		bra	=handle
=CSup		move.w	#-9920,d2		; step = -10240 pixels
=Cup		sub.w	#320,d2			; step = -320 pixels
		ext.l	d2
		bra.s	=startadr
=CSdown		move.w	#9920,d2		; step = -10240 pixels
=Cdown		add.w	#320,d2			; step = 320 pixels
		bra.s	=startadr
=Cnum4		moveq	#-64,d2
		bra.s	=modulo
=Cnum6		moveq	#64,d2
=modulo		move.l	modulo,d1
		add.l	d2,d1
		bpl	=modulo_ok
		moveq	#0,d1			; set to 0 if too low
=modulo_ok	move.l	d1,modulo
		bra	=Cspace
=CSnum4		move.w	#-768,d2
		ext.l	d2
		bra.s	=modulo
=CSnum6		move.w	#768,d2
		bra.s	=modulo
=CAnum4		moveq	#-1,d2
		bra.s	=modulo
=CAnum6		moveq	#1,d2
		bra.s	=modulo
=Creset		move.l	data,begbuf
=Cnum5		move.l	#(BYTESPERROW*8*256),modulo
		bra	=Cspace
=CSnum5		move.l	#(BYTESPERROW*16*256),modulo
		bra	=Cspace

=Cdigi		bsr	geti
		bmi.s	=away
		cmp.b	#($22!$80),d0
		bne.s	=Cdigi
		bsr	digitize
		bra	=Cspace

=away		moveq	#0,d7
=cleanup	bsr	freeint

		move.l	data,d0
		.if	ne
		 move.l	d0,a1
		 move.l	DATA,d0
		 call	FreeMem
		.end

		move.l	window,d0
		.if	ne
		 move.l	d0,a0
		 call	CloseWindow
		.end
		move.l	screen,d0
		.if	ne
		 move.l	d0,a0
		 call	CloseScreen
		.end
		bsr	freeparallel
		closlib	Intuition
		closlib	Gfx
		move.l	d7,d0
		.end	begin
		.end	local



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

geti		.local
		.subr	d2-d3/a0-a2
		move.l	window,a0
		move.l	wd_UserPort(a0),a2
		move.b	MP_SIGBIT(a2),d2
		moveq	#0,d0
		bset	d2,d0			set mp_SigBit
		bset	#12,d0			set ctrl_c
		call	Wait
		btst	d2,d0
		beq	=ctrlc
		move.l	window,a0
		move.l	wd_UserPort(a0),a2
		move.l	a2,a0
		fcall	GetMsg
		tst.l	d0
		beq.s	=nutton
		move.l	d0,a1
		moveq	#0,d2
		moveq	#0,d3
		cmp.l	#RAWKEY,im_Class(a1)
		bne.s	=reply
		move.w	im_Code(a1),d2
		move.w	im_Qualifier(a1),d3
=reply		fcall	ReplyMsg

=eat		move.l	a2,a0			; eat extra messages
		fcall	GetMsg
		tst.l	d0
		.if	ne
		 move.l	d0,a1
		 fcall	ReplyMsg
		 bra	=eat
		.end
		move.l	d3,d1			; return Qualifier
		move.l	d2,d0		 	; return a rawkey
		bra.s	=out
=ctrlc		moveq	#-1,d0
		bra.s	=out
=nutton		moveq	#0,d0
=out		.end 	subr
		.end	local


allocparallel	.local
		move.l	#HUGEMEM,d0		kick out the parallel.device!
		move.l	d0,d2
		moveq	#MEMF_PUBLIC,d1
		call	AllocMem
		tst.l	d0
		beq.s	=notgot
		move.l	d0,a1
		move.l	d2,d0
		fcall	FreeMem

=notgot		lea.s	'misc.resource',a1
		moveq.l	#0,d0
		fcall	OpenResource
		move.l	d0,.MiscResBase
		beq	=error

		moveq.l	#MR_PARALLELPORT,d0
		lea	prgname(pc),a1
		move.l	.MiscResBase,a6
		jsr	_LVOAllocMiscResource(a6)
		tst.l	d0
		bne.s	=error
		st	parport
		move.b	d0,datadir		set port as input
		rts				.ne if error
=error		moveq	#1,d0
		rts
		.end



freeparallel	.local
		tst.b	parport
		.if	ne
		 moveq	#MR_PARALLELPORT,d0
		 move.l	.MiscResBase,a6
		 jsr	_LVOFreeMiscResource(a6)
		.end
		rts
		.end


allocint	.local
		lea.s	'ciab.resource',a1
		call	OpenResource
		move.l	d0,.CIABase

		call	Disable
		lea	interr,a1
		move.b	#NT_INTERRUPT,LN_TYPE(a1)
		lea	prgname(pc),a0
		move.l	a0,LN_NAME(a1)
		lea	irqcode(pc),a0
		move.l	a0,IS_CODE(a1)		; addr of irq routine
		moveq	#CIAICRB_TA,d0		; we want timer A
		call	AddICRVector
		move.l	d0,d2
		bne	=error

		moveq	#1,d0
		fcall	AbleICR			; disable interrupt

		moveq	#1,d0
		fcall	SetICR			; clear interrupt

		call	Enable
		st	int
		moveq	#0,d0
		rts
=error		call	Enable
		moveq	#-1,d0			; error
		rts
		.end	local

freeint		.local
		tst.b	int
		.if	ne
		 moveq	#CIAICRB_TA,d0
		 lea	interr,a1
		 call	RemICRVector
		.end
irqcode		rts				; kludge, int doesn't do anything
		.end	local



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

		.local
digitize	.subr
		call	Disable			; 709379 kHz
		move.b	#68,timerl		; /8samples/320pixels/4Hz
		move.b	#0,timerh
		or.b	#$01,tcontrol		; start timer A

		lea	userport,a0		; source
		move.l	data,a1			; destination
		move.l	a1,begbuf
		move.l	#(BYTESPERROW*8*256),modulo
		lea	tint,a2
		move.l	DATA,d2			; # of bytes

		move.w	#$80,d1
=dloop		moveq	#7,d3			; sample #
		moveq	#0,d7			; clear sum
		btst	#0,(a2)
		beq.s	=dwait
		move.w	#$f00,$dff180
		bra.s	=dbusy

=dwait		btst	#0,(a2)
		beq.s	=dwait

=dbusy		moveq	#0,d0
		move.b	(a0),d0
		sub.w	d1,d0			; sub mid level
		bpl.s	=dwok			; positive?
		neg.w	d0			; no, make it
=dwok		add.w	d0,d7			; sum
		dbf	d3,=dwait		; do for 8 samples
		lsr.w	#2,d7			; shift sum
		move.b	d7,(a1)+		; save sample
		subq.l	#1,d2
		bne.s	=dloop

		fcall	Enable

		.end	subr
		.end	local


		.local
convert		.subr
		clr.l	bufpoi
		move.l	window,a0
		move.l	wd_UserPort(a0),a0
		move.b	MP_SIGBIT(a0),d7	; sigbit
		lbase	Exec

		move.l	screen,a2
		lea	sc_RastPort(a2),a2	; rp
		move.l	rp_BitMap(a2),a2	; bitmap
		lea.l	bm_Planes(a2),a5	; planeptrs
		movem.l	(a5),a0-a3		; get plane pointrs
		move.l	begbuf,a5		; source dataptr
		move.w	#ROWS-1,d6		; rows per plane

=rowloop	swap	d6
		move.w	#(BYTESPERROW/2-1),d6	; words to write per row
=byteloop	moveq	#15,d5			; bit counter
=bitloop	move.b	(a5)+,d4		; data byte
		roxr.b	#5,d4
		roxl.w	#1,d0			; plane 0
		roxr.b	#1,d4
		roxl.w	#1,d1			; plane 1
		roxr.b	#1,d4
		roxl.w	#1,d2			; plane 2
		roxr.b	#1,d4
		roxl.w	#1,d3			; plane 3
		dbf	d5,=bitloop

		move.w	d0,(a0)+
		move.w	d1,(a1)+
		move.w	d2,(a2)+
		move.w	d3,(a3)+
		dbf	d6,=byteloop

		moveq	#0,d0
		moveq	#0,d1
		push	a0-a1
		fcall	SetSignal		; user activity?
		pull	a0-a1
		btst	d7,d0
		beq.s	=go_on
		bsr	geti
		bmi.s	=away
		tst.b	d0
		bpl.s	=away			; got a new rawkey

=go_on		move.l	begbuf,a5		; restore buffer start address
		move.l	modulo,d0
		move.l	bufpoi,d1
		add.l	d0,d1
		move.l	d1,bufpoi
		asr.l	#8,d1
		add.l	d1,a5

		swap	d6
		dbf	d6,=rowloop

		moveq	#0,d0
=away		.end	subr
		.end	local



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

iniword		MACRO	* &offset,&value
		DC.B	$90
		DC.B	\1
		DC.W	\2
                ENDM
		
inilong		MACRO	* &offset,&value
		DC.B	$80
		DC.B	\1
		DC.L	\2
                ENDM
		
nscreen		iniword	ns_Width,BYTESPERROW*8
		iniword	ns_Height,ROWS
		iniword	ns_Depth,4
		iniword	ns_DetailPen,-1
		iniword	ns_ViewModes,V_SPRITES!V_LACE
		iniword	ns_Type,CUSTOMSCREEN!SCREENQUIET
		dc.w	0

nwindow		iniword	nw_Width,BYTESPERROW*8
		iniword	nw_Height,ROWS
		iniword	nw_DetailPen,-1
		inilong	nw_IDCMPFlags,RAWKEY
		inilong	nw_Flags,ACTIVATE!BORDERLESS!BACKDROP
		iniword	nw_Type,CUSTOMSCREEN
		dc.w	0

colors		dc.w	$0000,$0111,$0222,$0333,$0444,$0555,$0666,$0777
		dc.w	$0888,$0999,$0aaa,$0bbb,$0ccc,$0ddd,$0eee,$0fff

prgname		dc.b	'sat',0

		.purge

		section	hyi,bss

NS	ds.b	ns_SIZEOF
NW	ds.b	nw_SIZE
interr	ds.b	IS_SIZE


		end