* Source-Code für COM (COpperMonitor)
* (c) Roger Fischlin 3/89
* Dieses Programm ist Public-Domain !	



	incdir  	"vd0:include/"
	include	intuition/intuition.i
	include	intuition/intuition_lib.i
        	include 	exec/memory.i
	include	exec/exec_lib.i
	include	graphics/graphics_lib.i
	include	libraries/dos_lib.i
	include	libraries/dos.i
	include	graphics/text.i

TEXT	macro		; Macro zur Ausgabe eines Textes
	move	#\1,d0	
	move	#\2,d1	
	move.l	Window,a1
	move.l	wd_RPort(a1),a1
	CALLGRAF	Move		
	move	#\3,d0	
	move.l	Window,a1
	move.l	wd_RPort(a1),a1
	CALLGRAF	SetAPen
	lea	\4,a0	
	move.l	#\5,d0	
	move.l	Window,a1		
	move.l	wd_RPort(a1),a1	
	CALLGRAF	Text
	endm

	include	misc/easystart.i
	lea	intname(pc),a1    
	moveq	#0,d0		
	CALLEXEC 	OpenLibrary
	move.l	d0,_IntuitionBase 
	lea	grafname(pc),a1    
	moveq	#0,d0
	CALLEXEC 	OpenLibrary
	move.l	d0,_GfxBase
	move.l	d0,a0
	move.l	38(a0),Addresse  
	lea	windowdef,a0     
	CALLINT	OpenWindow
	move.l	d0,Window	
	tst.l	d0 	
	beq	exit
	move	#0,d0	
	move.l	Window,a1
	move.l	wd_RPort(a1),a1
	CALLGRAF	SetBPen
	move	#RP_JAM2,d0	
	move.l	Window,a1
	move.l	wd_RPort(a1),a1
	CALLGRAF	SetDrMd
	lea.l	FONT,a0            
	CALLGRAF	OpenFont           
	move.l	d0,Font
	move.l	d0,a0
	move.l	Window,a1
	move.l	wd_RPort(a1),a1
	CALLGRAF	SetFont
	move	#1,d0	
	move.l	Window,a1
	move.l	wd_RPort(a1),a1
	CALLGRAF	SetAPen
	move	#0,d0	
	move.l	Window,a1
	move.l	wd_RPort(a1),a1
	CALLGRAF	SetBPen
	move	#RP_JAM2,d0	
	move.l	Window,a1
	move.l	wd_RPort(a1),a1
	CALLGRAF	SetDrMd

	move.l	#2*204,d0
	move.l	#2,d1
	CALLEXEC	AllocMem
	move.l	d0,Im1_Mem
	beq	closewindow
	move.l	d0,a0		
	add.l	#204,d0
	move.l	d0,Im2_Mem
	lea.l	Pfeil1,a1
	move.l	#2*204-1,d0
label1	move.b	(a1)+,(a0)+
	dbra	d0,label1
	lea.l	Gadget1,a0
	move.l	Window,a1
	sub.l	a2,a2
	CALLINT	RefreshGadgets

	moveq	#0,d0	
	move	#177,d1	
	move.l	Window,a1
	move.l	wd_RPort(a1),a1
	CALLGRAF	Move		
	move	#1,d0	
	move.l	Window,a1
	move.l	wd_RPort(a1),a1
	CALLGRAF	SetAPen
	move.l	#400,d0	
	move	#177,d1
	move.l	Window,a1		
	move.l	wd_RPort(a1),a1	
	CALLGRAF	Draw
	
back	jsr	Print
	move.l	_GfxBase,a0
	move.l	38(a0),d2
	lsl.l	#8,d2
	lea.l	Text2+10,a0
	moveq.l	#5,d1
bnext	rol.l	#4,d2
	move.l	d2,d3
	and.b	#$f,d3
	add.b	#"0",d3
	cmp.b	#58,d3
	bcs	bout
	addq	#7,d3
bout	move.b	d3,(a0)+
	dbra	d1,bnext
	
	TEXT	250,(205-14),3,Text2,16




wait	move.l	Window,a0		
	move.l	wd_UserPort(a0),a0
	CALLEXEC	GetMsg
	tst.l	d0
	beq	wait
	move.l	d0,a1	
	move.l	im_Class(a1),d4
	move.l	im_IAddress(a1),a4	
	CALLEXEC 	ReplyMsg
	cmp.l	#CLOSEWINDOW,d4
	beq	QUIT
	moveq.l	#0,d0
	move.w	gg_GadgetID(a4),d0
	subq	#1,d0
	lsl.l	#2,d0
	add.l	#Vektoren,d0
	move.l	d0,a0
	move.l	(a0),a0
	jmp	(a0)
Vektoren	dc.l	DOWN,UP,GFX,wait


QUIT	move.l	Im1_Mem,a1
	move.l	#2*204,d0
	CALLEXEC	FreeMem	
closewindow	move.l	Window,a0
	CALLINT	CloseWindow
exit	moveq	#0,d0			
	rts				

W_Gadgets equ   WINDOWDRAG!WINDOWDEPTH!WINDOWCLOSE
W_Extras  equ   SMART_REFRESH!ACTIVATE
	even
windowdef      dc.w	110,0
	dc.w	400,200
	dc.b	-1,-1
	dc.l	CLOSEWINDOW!GADGETDOWN!GADGETUP
        	dc.l    	W_Gadgets!W_Extras  
	dc.l	Gadget1	
	dc.l	0	
	dc.l	Title
	dc.l	0	
	dc.l	0	
	dc.w	200,60
        	dc.w    	512,640
	dc.w	WBENCHSCREEN
Title	dc.b	"COM  by Roger Fischlin 3/89",0	


Gadget1	dc.l	Gadget2
	dc.w	20,-19,34,17
	dc.w	GADGHNONE!GRELBOTTOM!GADGIMAGE
	dc.w	GADGIMMEDIATE
	dc.w	BOOLGADGET
	dc.l	Image1,0
	dc.l	0
	dc.l	0,0
	dc.w	1
	dc.l	0
Gadget2	dc.l	Gadget3
	dc.w	20+50,-19,34,17
	dc.w	GADGHNONE!GRELBOTTOM!GADGIMAGE
	dc.w	GADGIMMEDIATE
	dc.w	BOOLGADGET
	dc.l	Image2,0
	dc.l	0
	dc.l	0,0
	dc.w	2
	dc.l	0
Gadget3	dc.l	0
	dc.w	20+110+30,-19,54,17
	dc.w	GADGHCOMP!GRELBOTTOM
	dc.w	RELVERIFY
	dc.w	BOOLGADGET
	dc.l	Border1,0
	dc.l	Text1
	dc.l	0,0
	dc.w	3
	dc.l	0

Text1	dc.b	3,1,RP_JAM1,0
	dc.w	15,5
	dc.l	FONT,T1,0
T1	dc.b	"GFX",0
Border1	dc.w	0,0
	dc.b	2,0,RP_JAM1,5
	dc.l	koor,0
koor	dc.w	0,0,53,0,53,16,0,16,0,0
Text2	dc.b	"Copper : $------"

intname	INTNAME	
grafname	GRAFNAME
dosname	DOSNAME	
_IntuitionBase	ds.l	1	
_GfxBase	ds.l	1
_DOSBase	ds.l	1
Window	ds.l	1
Font	dc.l	0
Memory	dc.l	0
Addresse	dc.l	CList
FONT	dc.l	fontname
	dc.w	TOPAZ_EIGHTY
	dc.b	FS_NORMAL
	dc.b	FPF_ROMFONT
	even 
fontname	dc.b	"topaz.font",0
	even


Pfeil1	dc.b $7f,$ff,$ff,$ff,$80,$00,$c0,$00,$00,$00,$c0,$00,$80,$03,$f0,$00
	dc.b $40,$00,$80,$03,$f0,$00,$40,$00,$80,$03,$f0,$00,$40,$00,$80,$03
	dc.b $f0,$00,$40,$00,$80,$03,$f0,$00,$40,$00,$80,$03,$f0,$00,$40,$00
	dc.b $8f,$ff,$ff,$fc,$40,$00,$83,$ff,$ff,$f0,$40,$00,$80,$ff,$ff,$c0
	dc.b $40,$00,$80,$3f,$ff,$00,$40,$00,$80,$0f,$fc,$00,$40,$00,$80,$03
	dc.b $f0,$00,$40,$00,$80,$00,$c0,$00,$40,$00,$c0,$00,$00,$00,$c0,$00
	dc.b $7f,$ff,$ff,$ff,$80,$00,$7f,$ff,$ff,$ff,$80,$00,$ff,$ff,$ff,$ff
	dc.b $c0,$00,$ff,$fc,$0f,$ff,$c0,$00,$ff,$fc,$0f,$ff,$c0,$00,$ff,$fc
	dc.b $0f,$ff,$c0,$00,$ff,$fc,$0f,$ff,$c0,$00,$ff,$fc,$0f,$ff,$c0,$00
	dc.b $ff,$fc,$0f,$ff,$c0,$00,$f0,$00,$00,$03,$c0,$00,$fc,$00,$00,$0f
	dc.b $c0,$00,$ff,$00,$00,$3f,$c0,$00,$ff,$c0,$00,$ff,$c0,$00,$ff,$f0
	dc.b $03,$ff,$c0,$00,$ff,$fc,$0f,$ff,$c0,$00,$ff,$ff,$3f,$ff,$c0,$00
	dc.b $ff,$ff,$ff,$ff,$c0,$00,$7f,$ff,$ff,$ff,$80,$00
	
Pfeil2	dc.b $7f,$ff,$ff,$ff,$80,$00,$c0,$00,$00,$00,$c0,$00,$80,$00,$c0,$00
	dc.b $40,$00,$80,$03,$f0,$00,$40,$00,$80,$0f,$fc,$00,$40,$00,$80,$3f
	dc.b $ff,$00,$40,$00,$80,$ff,$ff,$c0,$40,$00,$83,$ff,$ff,$f0,$40,$00
	dc.b $8f,$ff,$ff,$fc,$40,$00,$80,$03,$f0,$00,$40,$00,$80,$03,$f0,$00
	dc.b $40,$00,$80,$03,$f0,$00,$40,$00,$80,$03,$f0,$00,$40,$00,$80,$03
	dc.b $f0,$00,$40,$00,$80,$03,$f0,$00,$40,$00,$c0,$00,$00,$00,$c0,$00
	dc.b $7f,$ff,$ff,$ff,$80,$00,$7f,$ff,$ff,$ff,$80,$00,$ff,$ff,$ff,$ff
	dc.b $c0,$00,$ff,$ff,$3f,$ff,$c0,$00,$ff,$fc,$0f,$ff,$c0,$00,$ff,$f0
	dc.b $03,$ff,$c0,$00,$ff,$c0,$00,$ff,$c0,$00,$ff,$00,$00,$3f,$c0,$00
	dc.b $fc,$00,$00,$0f,$c0,$00,$f0,$00,$00,$03,$c0,$00,$ff,$fc,$0f,$ff
	dc.b $c0,$00,$ff,$fc,$0f,$ff,$c0,$00,$ff,$fc,$0f,$ff,$c0,$00,$ff,$fc
	dc.b $0f,$ff,$c0,$00,$ff,$fc,$0f,$ff,$c0,$00,$ff,$fc,$0f,$ff,$c0,$00
	dc.b $ff,$ff,$ff,$ff,$c0,$00,$7f,$ff,$ff,$ff,$80,$00


Image1	dc.w	-8,0,40,17,2
Im1_Mem	dc.l	Pfeil1
	dc.b	1+2,0
	dc.l	0
Image2	dc.w	-8,0,40,17,2
Im2_Mem	dc.l	Pfeil2
	dc.b	1+2,0
	dc.l	0

UP	sub.l	#4,Addresse
	jmp	back
DOWN	add.l	#4,Addresse
	jmp	back
GFX	move.l	_GfxBase,a0
	move.l	38(a0),Addresse
	jmp	back
NEW	jmp	wait
	

Zeile	dc.b	"$ ----- : -----                                           "

Print	move.l	#0,d6
	move.l	Addresse,a5
Pr1	lea.l	Zeile+2(pc),a0
	moveq.l	#5,d1
	move.l	a5,d2
	rol.l	#8,d2

next	rol.l	#4,d2
	move.l	d2,d3
	and.b	#$f,d3
	add.b	#"0",d3
	cmp.b	#58,d3
	bcs	out
	addq	#7,d3
out	move.b	d3,(a0)+
	dbra	d1,next
	movem.l	d6/a5,-(sp)

	lea.l	Zeile+10,a0
	move.l	#36,d0
Pr2	move.b	#" ",(a0)+
	dbra	d0,Pr2
	lea.l	Zeile+10,a0
	move.l	(a5),d0
	btst	#16,d0
	beq	CMOVE
	btst	#0,d0
	beq	CWAIT
	bne	CSKIP
Pr3	move	#10,d0	
	move.w	d6,d1
	mulu.w	#9,d1
	add	#20,d1
	move.l	Window,a1
	move.l	wd_RPort(a1),a1
	CALLGRAF	Move
	move.b	d6,d0
	and.b	#1,d0
	addq	#1,d0		
	move.l	Window,a1
	move.l	wd_RPort(a1),a1
	CALLGRAF	SetAPen
	lea	Zeile(pc),a0	
	move.l	#45,d0	
	move.l	Window,a1		
	move.l	wd_RPort(a1),a1	
	CALLGRAF	Text
	movem.l	(sp)+,d6/a5
	add.l	#4,a5
	addq	#1,d6
	cmp.w	#18,d6
	bne	Pr1
	rts


CMOVE	move.l	#"Move",(a0)+
	move.w	#" #",(a0)+
	move.b	#"$",(a0)+
	moveq.l	#3,d1
	move.w	2(a5),d2
	lsl.l	#8,d2
	lsl.l	#8,d2

cm_next	rol.l	#4,d2
	move.l	d2,d3
	and.b	#$f,d3
	add.b	#"0",d3
	cmp.b	#58,d3
	bcs	cm_out
	addq	#7,d3
cm_out	move.b	d3,(a0)+
	dbra	d1,cm_next
	move.b	#",",(a0)+
	move.b	#"$",(a0)+
	moveq.l	#2,d1
	move.w	(a5),d2
	and.l	#$1ff,d2
	lsl.l	#8,d2
	lsl.l	#8,d2
	lsl.l	#4,d2


cm_next2	rol.l	#4,d2
	move.l	d2,d3
	and.b	#$f,d3
	add.b	#"0",d3
	cmp.b	#58,d3
	bcs	cm_out2
	addq	#7,d3
cm_out2	move.b	d3,(a0)+
	dbra	d1,cm_next2
	bra	Pr3
CSKIP	move.l	#"Skip",(a0)+
	bra	CW_2

CWAIT	move.l	#"Wait",(a0)+
CW_2	move.w	#" (",(a0)+
	move.b	#"$",(a0)+
	moveq.l	#1,d1
	move.w	(a5),d2
	bclr	#0,d2
	lsl.l	#8,d2
	lsl.l	#8,d2
	lsl.l	#8,d2

cw_next	rol.l	#4,d2
	move.l	d2,d3
	and.b	#$f,d3
	add.b	#"0",d3
	cmp.b	#58,d3
	bcs	cw_out
	addq	#7,d3
cw_out	move.b	d3,(a0)+
	dbra	d1,cw_next
	move.b	#",",(a0)+
	move.b	#"$",(a0)+
	moveq.l	#1,d1
	move.w	(a5),d2
	lsl.l	#8,d2
	lsl.l	#8,d2


cw_next2	rol.l	#4,d2
	move.l	d2,d3
	and.b	#$f,d3
	add.b	#"0",d3
	cmp.b	#58,d3
	bcs	cw_out2
	addq	#7,d3
cw_out2	move.b	d3,(a0)+
	dbra	d1,cw_next2
	move.b	#")",(a0)+
	move.b	#" ",(a0)+
	move.b	#" ",(a0)+
	move.b	#" ",(a0)+
	move.b	#" ",(a0)+
	move.b	#"M",(a0)+
	move.b	#"a",(a0)+
	move.b	#"s",(a0)+
	move.b	#"k",(a0)+
	

	move.b	#"(",(a0)+
	move.b	#"$",(a0)+
	moveq.l	#1,d1
	move.w	2(a5),d2
	bclr	#0,d2
	lsl.l	#8,d2
	lsl.l	#8,d2
	lsl.l	#8,d2

cw_next3	rol.l	#4,d2
	move.l	d2,d3
	and.b	#$f,d3
	add.b	#"0",d3
	cmp.b	#58,d3
	bcs	cw_out3
	addq	#7,d3
cw_out3	move.b	d3,(a0)+
	dbra	d1,cw_next3
	move.b	#",",(a0)+
	move.b	#"$",(a0)+
	moveq.l	#1,d1
	move.w	2(a5),d2
	bset	#15,d2
	lsl.l	#8,d2
	lsl.l	#8,d2


cw_next4	rol.l	#4,d2
	move.l	d2,d3
	and.b	#$f,d3
	add.b	#"0",d3
	cmp.b	#58,d3
	bcs	cw_out4
	addq	#7,d3
cw_out4	move.b	d3,(a0)+
	dbra	d1,cw_next4
	move.b	#")",(a0)+
	move.b	#" ",(a0)+
	move.b	#" ",(a0)+
	move.w	2(a5),d0
	btst	#15,d0
	bne	cw_1
	move.b	#"B",(a0)+
	move.b	#"F",(a0)+
	
cw_1	bra	Pr3


CList	dc.w	$180,$aaa
	dc.w	$780f,$fffe
	dc.w	$182,$100
	dc.w	$180,$aaa
	dc.w	$780f,$7ffe
	dc.w	$182,$100
	dc.w	$180,$aaa
	dc.w	$780f,$f0ff
	dc.w	$182,$100
	dc.w	$180,$aaa
	dc.w	$780f,$fffe
	dc.w	$182,$100
	dc.w	$180,$aaa
	dc.w	$780f,$fffe
	dc.w	$182,$100