section l,code_c

; ****************************************************
; *****                                          *****
; *****                MemSearch                 *****
; *****              ------------                *****
; *****                                          *****
; *****      By :   Orlando Budelacci            *****
; *****             Birmannsgasse 34             *****
; *****             CH-4055 Basel                *****
; *****             Switzerland                  *****
; *****                                          *****
; *****   Comments and contributions welcomed!   *****
; *****                                          *****
; ****************************************************

; ---------- Note -----------

; *** Object file MUST have chip hunks !
; *** Else it WON'T work on computers with fast memory !!!!!!!!

; *** THE PROGRAM ISN'T STARTABLE FROM THE ASSEMBLER
; *** BECAUSE OF THE TEXTOUTPUT, SO SAVE THE EXECUTABLE
; *** AND HAVE A LOOK AT IT THEN...

; Written with Masterseka

; ---------- Versions --------

; *** Version V1.01 finished May, 17th 1990
; *** 100% pc-relative

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

; *** Start of program ***

start:

; *** AllocMem for the info board ***

	move.l	4.w,a6
	move.l	#80*28,d0		;size ? 28 lines/hires
	move.l	#$10002,d1		;type
	jsr	-198(a6)	
	lea	memadr(pc),a2
	move.l	d0,(a2)
	bne.s	alloc_rastport_mem
	rts

; *** Alloc rastport memory ***
; *** Pointer to rastport in label : 'rastport' ***

alloc_rastport_mem:
	moveq	#100,d0			;size ? 28 lines/hires
	move.l	#$10002,d1		;type / chip / clear
	jsr	-198(a6)	
	lea	rastport(pc),a2
	move.l	d0,(a2)
	bne.s	open_dos
	bra.L	freemem			;if error while allocating
					;rastport mem, then
					;free status line memory

; *** open dos ***

open_dos:	
	lea	dosname(pc),a1
	jsr	-408(a6)	
	lea	dosbase(pc),a2
	move.l	d0,(a2)
	
; *** Put start/end addresses *** 

	lea	madr2(pc),a1
	move.l	memadr(pc),d2
	add.l	#[80*28],d2
	bsr.L	long_to_ascii

	lea	madr(pc),a1
	move.l	memadr(pc),d2
	bsr.L	long_to_ascii

; *** Get output window ***
; *** you get : output handle  in label 'outhandle'

get_out_put:
	move.l	dosbase(pc),a6
	jsr	-60(a6)			;OutPut
	lea	outhandle(pc),a3
	move.l	d0,(a3)

	lea	help(pc),a2
	move.l	a2,d2
	move.l	#helpend-help,d3
	jsr	-48(a6)

; *** Wait return to start ***

	move.l	outhandle(pc),d1
	jsr	-42(a6)			;Read	

; *** forbid ***

forbid:
	move.l	4.w,a6
	jsr	-132(a6)

; *** Set copper bpl's to allocated memory ***

	lea	tab_location+2(pc),a0
	move.l	memadr(pc),d1
	swap	d1
	move.w	d1,(a0)
	addq.w	#4,a0
	swap	d1
	move.w	d1,(a0)

; *** Set up system things ***

init_system:
	lea	gfxname(pc),a1
	jsr	-408(a6)	
	lea	gfxbase(pc),a2
	move.l	d0,(a2)

init_bitmap:
	move.l	gfxbase(pc),a6
	lea	bitmap(pc),a0
	moveq	#1,d0
	move.l	#640,d1
	moveq	#28,d2
	jsr	-390(a6)
	lea	bitmap+8(pc),a2		;Initbitmap
	move.l	memadr(pc),(a2)

initrastport:
	move.l	rastport(pc),a1		;InitRastport
	jsr	-198(a6)
	
	move.l	rastport(pc),a5
	lea	bitmap(pc),a3
	move.l	a3,4(a5)

; *** Insert correct pointer to fontname in the txtstruc ***

	lea	txtstruc(pc),a0
	lea	fontname(pc),a1
	move.l	a1,(a0)

open_font:
	lea	txtstruc(pc),a0
	jsr	-72(a6)			;OpenFont
	move.l	d0,a0
	move.l	rastport(pc),a1
	jsr	-66(a6)			;SetFont

moverast:
	move.l	rastport(pc),a1
	moveq	#20,d0
	moveq	#10,d1
	jsr	-240(a6)

ext:
	move.l	#textend-text,d0
	move.l 	rastport(pc),a1
	lea	text(pc),a0
	jsr	-60(a6)			;Text

; *** Start displaying ***

start_copper:
	lea	copper(pc),a2
	move.l	a2,$dff080

; *** Start interrupt ***

start_int:
	lea	intvec(pc),a2
	move.l	$6c,(a2)
	lea	int(pc),a2
	move.l	a2,$6c

mouse:
	bsr.L	fkeys
	lea	endflag(pc),a2
	tst.b	(a2)
	bne.s	close_all

	btst	#6,$bfe001
	bne.s	mouse
	
Close_all:
	move.l	gfxbase(pc),a0
	lea	$dff000,a3
	move.l	38(a0),$80(a3)
	move.w	#$83f0,$96(a3)
	lea	intvec(pc),a2
	move.l	(a2),$6c

close_gfx:
	move.l	4.w,a6
	move.l	gfxbase(pc),a1
	jsr	-414(a6)	

close_dos:
	move.l	dosbase(pc),a1
	jsr	-414(a6)

permit:
	move.l	4.w,a6
	jsr	-138(a6)
freemem:			;bitplane
	move.l	memadr(pc),a1
	move.l	#80*28,d0		;size 28 lines /hires
	jsr	-210(a6)

end:
	moveq	#0,d0
	rts

; *** Interrupt ***

int:
	movem.l	d0-d7/a0-a6,-(sp)

; *** Make longword from 2 words at bpl position ***

makelo:	lea	bpl(pc),a1
	bsr.L	create_longword		;save longword in 
					;pointer longword
; *** $000000 to $7ffff ***

	lea	longadr(pc),a3
	move.l	(a3),d0
	move.l	speed(pc),d1
	cmp.l	d1,d0				
	blo.s	low			;branch if lower
	move.l	#$7ffff,d2
	sub.l	d1,d2
	cmp.l	d2,d0
	bhi.s	high			;branch if higher
	bra.s	keys
low:
	move.l	#$7ffff-961,(a3)
	bra.s	keys
high:
	move.l	#$0+961,(a3)

; *** Key test ***

keys:
	move.b	$bfec01,d0		
	move.l	speed(pc),d5
	lea	longadr(pc),a3
	lea	statusflag(pc),a4
	lea	modtext(pc),a5

	cmp.b	#$65,d0		
	beq.s	down
	cmp.b	#$67,d0
	beq.s	up
	cmp.b	#$63,d0
	beq.s	right
	cmp.b	#$61,d0
	beq.s	left
	cmp.b	#$33,d0
	beq.L	moduloUp
	cmp.b	#$37,d0
	beq.L	ModuloDown	

	bra.s	exit	

down:
	add.l	d5,(a3)
	bra.s	exit

right:
	addq.l	#2,(a3)
	bra.s	exit
left:
	subq.l	#2,(a3)
	bra.s	exit

up:
	sub.l	d5,(a3)

exit:	

; *** recalculate longword in two words for copper list ***

	move.l	longadr(pc),d2
	bsr.L	make_words
	lea	numtext(pc),a1

; *** Address is in d2 / calculate ascii values 
; *** and write them into 'num' ***

	bsr.L	long_to_ascii

; *** Move rastport to correct position ***

	move.l	gfxbase(pc),a6
	move.l	rastport(pc),a1
	move.l	#572,d0
	moveq	#10,d1
	jsr	-240(a6)

; *** Print contents of pointer 'longadr' ***

	move.l	#numtextend-numtext,d0
	move.l	rastport(pc),a1
	lea	numtext(pc),a0
	jsr	-60(a6)			;Text

; *** Restore status line ? ***

	lea	statusflag(pc),a2
	cmp.b	#1,(a2)
	bne.s	endi

; *** Status line / move rastport ***

	move.l	rastport(pc),a1
	moveq	#20,d0
	moveq	#20,d1
	jsr	-240(a6)

; *** Print status line ***

	move.l	#infotextend-infotext,d0
	move.l	rastport(pc),a1
	lea	infotext(pc),a0
	jsr	-60(a6)			;Text
	lea	statusflag(pc),a2
	clr.b	(a2)

; *** End of interrupt ***

endi:	
	movem.l	(sp)+,d0-d7/a0-a6	
	dc.w	$4ef9

intvec:dc.l	0

; *** Subroutines ***


; *** Display help text ***

helpME:

end_interrupt:
	move.l	intvec(pc),$6c
	lea	$dff000,a5

	move.w	#$8020,$96(a5)
	move.l	4.w,a6
	jsr	-138(a6)

	lea	gfxname(pc),a1
	jsr	-408(a6)
	move.l	d0,a0
	move.l	38(a0),$80(a5)

	move.l	dosbase(pc),a6
	move.l	outhandle(pc),d1
	lea	helptext(pc),a2
	move.l	a2,d2
	move.l	#Helptextend-helptext,d3
	jsr	-48(a6)

	move.l	outhandle(pc),d1
	jsr	-42(a6)			;Read

	move.l	4.w,a6
	jsr	-132(a6)

	lea	intvec(pc),a2
	move.l	$6c,(a2)
	lea	int(pc),a2
	move.l	a2,$6c

	move.w	#$0020,$96(a5)

	lea	copper(pc),a2
	move.l	a2,$80(a5)
	rts

; *** Longword to ascci-string ***

; *** Values  :   a1 = pointer to destination
;		  d2 = source

long_to_ascii:
	moveq	#7,d1

asciiloop1:
	rol.l	#4,d2
	move.l	d2,d3
	and.b	#15,d3
	add.b	#$30,d3
	cmp.b	#$3a,d3
	bcs.s	asciiloop2
	addq.b	#7,d3
asciiloop2:
	move.b	d3,(a1)+
	dbra	d1,asciiloop1
	add.l	#20,a1
	rts

; *** Create longword from 4 words ***

; *** Values  :    a1 = pointer to begin of 4 words


; *** You get :    longword in label 'longadr'

create_longword:
	addq.w	#2,a1
	move.w	(a1),d5
	swap	d5
	addq.w	#4,a1
	move.w	(a1),d5
	lea	longadr(pc),a1
	move.l	d5,(a1)
	rts

; *** Make longword for 4 copper words ***

; *** values  :   a1 = pointer to bpl
;		  d2 = what to put in bpl

; *** You get :   longword in 2 words at bpl in copper-list1

make_words:
	lea	bpl(pc),a1
	addq.w	#2,a1
	swap	d2		
	move.w	d2,(a1)
	addq.w	#4,a1
	swap	d2
	move.w	d2,(a1)
	rts

; *** Put text in current window ***

; *** You give  : d2 = pointer to text 
;		  d3 = lenght of text 

; *** you get   : text in current window 

text_dos:
	move.l	dosbase(pc),a6
	move.l	outhandle(pc),d1
	jmp	-48(a6)		;Write

; *** Test function keys ***

fkeys:
	move.b	$bfec01,d0
	lea	infotext+19(pc),a0
	lea	statusflag(pc),a4
	lea	speed(pc),a5
	lea	bplcon0+2(pc),a3
	lea	color+2(pc),a2

	cmp.b	#$5f,d0
	beq.L	speed1	
	cmp.b	#$5d,d0
	beq.L	speed2	
	cmp.b	#$5b,d0
	beq.L	speed3	
	cmp.b	#$59,d0
	beq.L	speed4	
	cmp.b	#$57,d0
	beq.L	speed5	
	cmp.b	#$55,d0
	beq.L	LoRes	
	cmp.b	#$53,d0
	beq.L	Hires
	cmp.b	#$51,d0
	beq.L	address1
	cmp.b	#$4f,d0
	beq.L	address2
	cmp.b	#$4d,d0
	beq.L	color1
	cmp.b	#$3f,d0
	bne.s	test_help
	lea	modulo+2(pc),a6
	lea	modtext(pc),a5
	move.w	#$0000,(a6)
	move.b	#'0',(a5)+
	move.b	#'0',(a5)+
	move.b	#'0',(a5)+
	move.b	#'0',(a5)
	move.b	#1,(a4)		;refresh beam

test_help:
	cmp.b	#$41,d0
	beq.L	helpME
	cmp.b	#$75,d0
	bne.s	fkeys_fertig
	lea	endflag(pc),a1
	move.b	#1,(a1)

fkeys_fertig:
	rts

; *** The different speeds ***
; *** Pointer to statusflag in a4
; *** Pointer to speed in a5
	
speed1:	
	move.b	#'1',(a0)
	move.l	#80,(a5)
	move.b	#1,(a4)
	rts

speed2:
	move.b	#'2',(a0)
	move.l	#160,(a5)
	move.b	#1,(a4)
	rts
speed3:
	move.b	#'3',(a0)
	move.l	#240,(a5)
	move.b	#1,(a4)
	rts

speed4:
	move.b	#'4',(a0)
	move.l	#480,(a5)
	move.b	#1,(a4)
	rts

speed5:
	move.b	#'5',(a0)
	move.l	#960,(a5)
	move.b	#1,(a4)
	rts
	
; *** Change resolution ***
; *** Pointer to bplcon0+2 in a3
; *** Pointer to statusfalg in a4
; *** Pointer to color+2 in a2

LoRes:		
	move.w	#$1200,(a3)	
	lea	infotext+32(pc),a0
	move.b	#'L',(a0)+
	move.b	#'o',(a0)
	move.b	#1,(a4)
	rts

Hires:
	move.w	#$9200,(a3)
	lea	infotext+32(pc),a0
	move.b	#'H',(a0)+
	move.b	#'i',(a0)
	move.b	#1,(a4)
	rts

address1:
	move.l	#$20000,d2
	bsr.L	make_words
	rts

address2:
	move.l	#$65000,d2
	bsr.L	make_words
	rts

; *** Insert new color ****

Color1:
	clr.b	$bfec01
	lea	infotext+52(pc),a0
	lea	colorcount(pc),a5
	addq.b	#1,(a5)
	cmp.b	#1,(a5)
	beq.s	green

	cmp.b	#2,(a5)
	beq.s	blue

	cmp.b	#3,(a5)
	beq.s	white

Green:
	move.b	#'4',(a0)+
	move.b	#'a',(a0)+
	move.b	#'4',(a0)
	move.b	#1,(a4)
	move.w	#$04a4,(a2)
	rts

White:
	move.b	#'a',(a0)+
	move.b	#'a',(a0)+
	move.b	#'a',(a0)
	move.b	#1,(a4)
	move.w	#$0aaa,(a2)
	clr.b	(a5)
	rts

Blue:
	move.b	#'7',(a0)+
	move.b	#'7',(a0)+
	move.b	#'f',(a0)
	move.b	#1,(a4)
	move.w	#$055f,(a2)
	rts


; *** The modulo value change routine ***
; *** a5 = pointer to modtext
; *** a4 = pointer to statusflag

ModuloUp:
	lea	modulo+2(pc),a1
	lea	modcounter(pc),a0
	cmp.b	#7,(a0)	
	bne.s	goback
	addq.w	#$0002,(a1)
	
; *** Display ascii value of modulo ***

	moveq	#3,d1			;4 chars
	move.l	(a1),d2			;value to display
	lea	modtext(pc),a1
	bsr.L	asciiloop1		;bin to ascii
	move.b	#1,(a4)			;set status flag / 
	clr.b	(a0)

goBACK:	
	addq.b	#1,(a0)
	bra.L	exit

ModuloDown:
	lea	modulo+2(pc),a1
	lea	modcounter2(pc),a0

	cmp.b	#10,(a0)	
	bne.s	goback2
	subq.w	#$0002,(a1)
	clr.b	(a0)

; *** Insert ascii value in status line ***

	moveq	#3,d1			;4 chars
	move.l	(a1),d2			;pointer to source (modtext)
	lea	modtext(pc),a1
	bsr.L	asciiloop1		;bin to ascii
	move.b	#1,(a4)			;set status flag / 
	clr.b	(a0)

goBACK2:
	addq.b	#1,(a0)
	bra.L	exit

; -------------------- The copper list --------------------

copper:
	dc.w	$0096,$0020
	dc.w	$0102,$0000
	dc.w	$008e,$2c81
	dc.w	$0090,$2cc1
	dc.w	$0092,$0038
	dc.w	$0094,$00d0
	dc.w	$0180,$0000
	dc.w	$0108,$0000

tab_location:
	dc.w	$00e0,$0007
	dc.w	$00e2,$0000
	dc.w	$0100,$9200

; *** Beam at bottom of screen ***

	dc.w	$0182,$0aaf
	dc.w	$2c11,$fffe,$0180,$0009
	dc.w	$2f11,$fffe,$0180,$000b

	dc.w	$4311,$fffe,$0180,$0009
	dc.w	$4611,$fffe,$0180,$0000
color:	dc.w	$0182,$0aaa

; *** Start location of plane ***

bpl:	dc.w	$00e0,$0006
	dc.w	$00e2,$0000

modulo:	dc.w	$0108,$0000

bplcon0:dc.w	$0100,$9200

	dc.w	$ffff,$fffe

; *** Text / Datas ***

text:	dc.b	'MemSearch V1.01 /  1990 by Orlando B. /  '
	dc.b	'Current address position : $'
textend:
numtext:dc.b	'00000000'
numtextend:

infotext:
	dc.b	'STATUS :  Speed : 04  /  Mode : HiRes  /  Color : $0aaa  /'
	dc.b	'  Modulo : $'
modtext:
	dc.b	'0000'
modtextend:
infotextend:

; *** System things ***

gfxname:	dc.b	'graphics.library',0
		even
gfxbase:	dc.l	0
bitmap:		blk.b	16,0
rastport:	dc.l	0

; *** Things for address display ***

longadr:	dc.l	0
memadr:		dc.l	0
speed:		dc.l	480

txtstruc:
	dc.l	0
	dc.w	8
	dc.w	0

fontname:	dc.b	'topaz.font',0
	even
dosbase:	dc.l	0
outhandle:	dc.l	0
dosname:	dc.b	'dos.library',0
		even

help:	
	dc.b	$a
	dc.b	$9b,"0;33;40m"
	dc.b	'MemSearch V1.01'
	dc.b	$9b,"0;31;40m"
	dc.b	' - by Orlando Budelacci, May 1990, Public Domain.',$a
	dc.b	'Bitplane memory allocated from $'
madr:	dc.b	'00000000 to $'
madr2:	dc.b	'00000000',$a,$a
	dc.b	'<Return>'
helpend:


; **** Datas for the Help page ****

helptext:
	dc.b	0,0,$c,$a,$a
	dc.b	'F1 to F5 = Different speeds (slow to fast)',$a
	dc.b	'F6 = LoRes',$a
	dc.b	'F7 = HiRes',$a
	dc.b	'F8 = Go to $20000',$a
	dc.b	'F9 = Go to $65000',$a
	dc.b	'FA = Change color',$a,$a
	dc.b	'Left Alt   = Decrease modulo',$a
	dc.b	'Left Amiga = Increase modulo',$a
	dc.b	'Left Shift = Reset modulo',$a
	dc.b	'Cursor Keys= Change address position',$a
	dc.b	'Escape     = Quit',$a
	dc.b	'Left Button= Quit',$a,$a
	dc.b	'Press <Return>'
helptextend:

; *** Color routine ***

colorcount:	dc.b	0
statusflag:	dc.b	1

; *** Datas for modulo change routine ***

modcounter:	dc.w	0
modcounter2:	dc.w	0
endflag:	dc.b	0

nd: