;	Mem v1.0
;	--------

version macro
	dc.b	' v1.0 '
	endm

	mc68000			; snma option.

	include	exec/memory.i
	include	dos/dos.i
	include	intuition/intuition_nocomments.i

	include	libraries/execxref.i
	include	libraries/dosxref.i
	include	libraries/intuitionxref.i
	include	libraries/graphicsxref.i
	include	include/macros.i

	structure	datas,0
		aptr	dosbase
		aptr	intuitionbase
		aptr	gfxbase
		aptr	diskfontbase
		aptr	buffer
		aptr	windowptr
		aptr	rastport
		long	doskfont
		word	fontlength
		word	fontheight
		label	datas_SIZEOF

bufferlen		equ	1024*2
_LVOOpenDiskFont	equ	-$1e


	section	code,code

	clr.b	-1(a0,d0)		; zero to the end of command line.
	movea.l	a0,a5			; store cmd. line ptr.

	move.l	#datas_SIZEOF,d0
	move.l	#MEMF_ANY!MEMF_CLEAR,d1
	move.l	4,a6
	call	AllocMem
	move.l	d0,a4
	tst.l	d0
	beq	cleanup

	openlib	dos,0,cleanup
	openlib	intuition,0,cleanup
	openlib	gfx,0,cleanup
	openlib	diskfont,0,cleanup

	move.l	#bufferlen,d0
	move.l	#MEMF_ANY!MEMF_CLEAR,d1
	call	AllocMem
	move.l	d0,buffer(a4)
	beq	cleanup

	bsr	parsefont
	bsr	initialize		; open window
	tst.l	d0
	bmi	cleanup

	bsr	wait_loop		; wait until user requests quit.

;	------------------------

cleanup	move.l	a4,d0
	beq	_999

	move.l	windowptr(a4),d0	; free all resources.
	beq	_99
	move.l	d0,a0
	lea	gadg01(pc),a1
	move.l	intuitionbase(a4),a6
	call	RemoveGadget
	move.l	windowptr(a4),a0
	call	CloseWindow

_99	move.l	doskfont(a4),d0
	beq	_98
	move.l	d0,a1
	move.l	gfxbase(a4),a6
	call	CloseFont

_98	move.l	4,a6
	closlib	dos
	closlib	intuition
	closlib	gfx
	closlib	diskfont

	move.l	buffer(a4),d0
	beq	_100
	move.l	d0,a1
	move.l	#bufferlen,d0
	call	FreeMem

_100	move.l	a4,d0
	beq	_999
	move.l	d0,a1
	move.l	#datas_SIZEOF,d0
	call	FreeMem

_999	moveq	#0,d0
	rts

;	*********************************************************

dosname		dc.b	'dos.library',0
intuitionname	dc.b	'intuition.library',0
gfxname		dc.b	'graphics.library',0
diskfontname	dc.b	'diskfont.library',0
font_1		dc.b	'topaz.font',0
formatstring	dc.b	'Chip:    %8.8ld  Fast:  %8.8ld ',10
		dc.b	'Virtual: %8.8ld  Total: %8.8ld ',10
		dc.b	'$VER: Mem'
		version
teststring	dc.b	'By: Jarkko Vatjus-Anttila <quaid@kempele.fi>',0
prefsname1	dc.b	'ENVARC:MEMPrefs',0
prefsname2	dc.b	'ENV:MEMPrefs',0
		even
coords		dc.w	12,10,12,22

putcharproc	move.b	d0,(a3)+
		rts

font1	dc.l	font_1
	dc.w	8
	dc.b	0,0

window	dc.w	0,0,300,28
	dc.b	0,1
	dc.l	IDCMP_VANILLAKEY,WFLG_NW_EXTENDED
	dc.l	gadg01,0,0,0,0
	dc.w	0,0,0,0,WBENCHSCREEN
	dc.l	extension

extension
	dc.l	WA_AutoAdjust,1
	dc.l	TAG_DONE,0
	
gadg01	dc.l	0
	dc.w	1,1,308,23
	dc.w	GFLG_GADGHNONE,GACT_RELVERIFY,GTYP_SYSGADGET!GTYP_WDRAGGING
	dc.l	0,0,0,0,0
	dc.w	0
	dc.l	0

;	*******************************************************

initialize
	bsr	loadprefs
	bsr	getmem

	lea	font1(pc),a0
	move.l	diskfontbase(A4),a6
	call	OpenDiskFont
	move.l	d0,doskfont(a4)
	beq	nofont2

	lea	rps,a1
	move.l	gfxbase(a4),a6
	call	InitRastPort
	lea	rps,a1
	move.l	doskfont(a4),a0
	call	SetFont

	lea	rps,a1
;	lea	teststring(pc),a0
	move.l	buffer(a4),a0
	moveq	#34,d0
	call	TextLength
	lea	window(pc),a0
	add.w	#12*2,d0
	move.w	d0,nw_Width(a0)

	bra	openwindow

nofont2	lea	font1(pc),a0	; open default font (topaz.font 8)
	move.l	#font_1,(a0)
	move.w	#8,4(a0)
	move.l	gfxbase(a4),a6
	call	OpenFont
	move.l	d0,doskfont(a4)
	beq	initialize_fail

openwindow
	lea	window(pc),a0
	move.l	intuitionbase(a4),a6
	call	OpenWindow
	move.l	d0,windowptr(a4)
	beq	initialize_fail
	move.l	d0,a0				; open window ...
	move.l	wd_RPort(a0),rastport(a4)

	move.l	doskfont(a4),a0			; ... and set font.
	move.l	rastport(a4),a1
	move.l	gfxbase(a4),a6
	call	SetFont

	move.l	rastport(a4),a1
	moveq	#0,d0
	call	SetDrMd

	bsr	displaymem

	moveq	#0,d0			; return code ok
	rts

initialize_fail
	moveq	#-1,d0			; fail.
	rts

;	**************************************************************

wait_loop
	move.l	windowptr(a4),a3
	move.l	wd_UserPort(a3),a3	; wait for IDCMP events
	moveq	#0,d3

wait_loop_loop
	movea.l	a3,a0			; userport -> a0
	move.l	4,a6
	call	GetMsg			; get every message.
	tst.l	d0			; Avoid queue.
	beq	wait_loop_exit

	move.l	d0,a1			; take Class and Code
	moveq	#0,d4
	move.l	im_Class(a1),d3		; idcmp class
	move.w	im_Code(a1),d4		; message code
	call	ReplyMsg
	bra.s	wait_loop_loop

wait_loop_exit
	cmp.l	#IDCMP_VANILLAKEY,d3
	beq	wait_loop_checkquit
wait_lp	move.l	dosbase(a4),a6
	moveq	#75,d1
	call	Delay
	bsr	getmem
	bsr	displaymem
	bra	wait_loop_loop

wait_loop_checkquit
	cmp.w	#27,d4			; 27 = esc
	beq	wait_loop_quit
	cmp.w	#"s",d4
	bne	wait_lp
	bsr	saveprefs
	moveq	#0,d4
	bra	wait_lp
wait_loop_quit
	rts

;	**************************************************************

getmem	push	a3		; getmem reads current free memory in
	move.l	#MEMF_PUBLIC,d1	; system and initializes the memory
	move.l	4,a6		; information string with RawDoFmt()
	call	AvailMem
	move.l	d0,d7
	move.l	#MEMF_FAST,d1
	call	AvailMem
	move.l	d0,d6
	move.l	#MEMF_CHIP,d1
	call	AvailMem
	move.l	d0,d5

	move.l	d6,-(sp)
	add.l	d5,(sp)

	move.l	d7,d1
	sub.l	d5,d1
	move.l	d6,d0
	sub.l	d1,d0
	bpl	vir_ok
	move.l	#0,-(sp)
	bra	vir_ok2
vir_ok	move.l	d0,-(sp)
	sub.l	d0,d6
vir_ok2	move.l	d6,-(sp)
	move.l	d5,-(sp)
	
	lea	formatstring(pc),a0
	move.l	sp,a1
	lea	putcharproc(pc),a2
	movea.l	buffer(a4),a3
	call	RawDoFmt
	add.l	#16,sp
	pull	a3
	rts

;	*************************************************************

parsefont
	move.l	a5,a0
	moveq	#8,d1
pf_loop	tst.b	(a0)
	beq	pf_ok1
	cmp.b	#" ",(a0)+
	bne	pf_loop
	move.b	#0,-1(a0)
	moveq	#0,d0
	move.b	(a0),d0
	sub.l	#"0",d0
	bmi	pf_ok1
	cmp.l	#58-"0",d0
	bpl	pf_ok1
	move.w	d0,d1
pf_ok1	lea	font1(pc),a0
	move.l	a5,(a0)
	move.w	d1,4(a0)
	rts

;	*************************************************************

displaymem
	push	all		; displaymem displays the formatted
	bsr	clearwindow

	moveq	#1,d0		; memory string.
	move.l	rastport(a4),a1
	move.l	gfxbase(a4),a6
	call	SetAPen
	lea	coords(pc),a5
	move.l	buffer(a4),a3
	moveq	#2-1,d7
dm_loop	move.w	(a5)+,d0
	move.w	(a5)+,d1
	move.l	rastport(a4),a1
	call	Move
	movea.l	a3,a0
	moveq	#0,d0
dm_lp2	addq.l	#1,d0
	cmp.b	#10,(a0)+
	bne	dm_lp2
	exg	a0,a3
	subq.l	#1,d0
	move.l	rastport(a4),a1
	call	Text
	dbra	d7,dm_loop
	pull	all
	rts

;	*************************************************************

clearwindow
	move.l	rastport(a4),a1
	move.b	rp_FgPen(a1),d5

	moveq	#0,d0
	move.l	gfxbase(a4),a6
	call	SetAPen

	move.l	rastport(A4),a1
	moveq	#4,d0
	moveq	#2,d1
	move.w	window+4(pc),d2
	subq.l	#5,d2
	move.w	window+6(pc),d3
	subq.l	#3,d3
	call	RectFill

	move.b	d5,d0
	and.w	#$ff,d0
	move.l	rastport(a4),a1
	call	SetAPen
	rts

;	*************************************************************

saveprefs
	push	all
	move.l	#prefsname1,d1
	move.l	#MODE_NEWFILE,d2
	move.l	dosbase(a4),a6
	call	Open
	move.l	d0,d7
	beq	sp_fail

	move.l	windowptr(a4),a1
	move.l	wd_LeftEdge(A1),-(sp)
	move.l	d7,d1
	move.l	sp,d2
	moveq	#4,d3
	call	Write
	add.l	#4,sp
	move.l	d7,d1
	call	Close

sp_fail	pull	all
	rts

;	*************************************************************

loadprefs
	push	all
	move.l	#prefsname2,d1
	move.l	#MODE_OLDFILE,d2
	move.l	dosbase(a4),a6
	call	Open
	move.l	d0,d7
	beq	lp_fail

	sub.l	#4,sp
	move.l	d0,d1
	move.l	sp,d2
	moveq	#4,d3
	call	Read
	move.l	d7,d1
	call	Close

	lea	window(pc),a0
	move.l	(sp),(a0)
	add.l	#4,sp

lp_fail	pull	all
	rts


	section lammas,bss
rps	ds.b	512