;=============================================================================
;==                    Titleclock for Workbench                             ==
;==                © Henryk Richter "Buggs of DEFECT"                       ==
;==                     written on ASM-ONE 1.25                             ==
;==                            Freeware                                     ==
;=============================================================================
;
ver	macro
	dc.b	`1.12`
	endm
date	macro
	dc.b	`20-Nov-96`
	endm
;
;--------------------------- Asm-Tester ------------------------------
test	=	0
;-------------------- für welche Systemversion ? ---------------------
Kickversion	= 39			;37,38,39
;------------------- diese Variablen so lassen -----------------------
LockLayer	=	1		;nur zum  Test ausmachen
deutsch		=	0		;obsolet
;-------------------- Angabe der Versionen  --------------------------
	if	Kickversion=37
locale		=	0		;Kick 2.0, eingebaute Strings
Use21		=	1
	else
	if	Kickversion=38
locale		=	1		;Kick2.1, wie 2.0, nur Locale
Use21		=	1
	else
locale		=	1		;Kick 3.x Locale on/Use21 off
Use21		=	0
	endc
	endc
;---------------------------------------------------------------------
	Incdir	include:
	include	EXEC/Exec_lib.i
	include libraries/Dos_lib.i
	include dos/Dos.i
	include dos/var.i
	include	Intuition/Intuition_lib.i
	include	utility/utility.i
	include	utility/date.i
	include	libraries/utility_lib.i
	include	devices/timer.i
	include	libraries/timer_lib.i
	include	graphics/rastport.i
	include	graphics/layers.i
	include	graphics/graphics_Lib.i
	include	intuition/screens.i
	include	exec/interrupts.i
	include	exec/tasks.i
	include	exec/memory.i
	include	libraries/commodities.i
	include	libraries/commodities_lib.i
	include	workbench/startup.i
	include	libraries/icon_lib.i
	include	libraries/locale_lib.i
	include	libraries/locale.i
	include	workbench/workbench.i

start
	move.l	4.w,a6
	link	a5,#-Dataslen
	lea	-dataslen(a5),a5

	move.l	a5,a0
	move.w	#DatasLen-1,d0
.clr
	clr.b	(A0)+
	dbf	d0,.clr
	st	enabled(A5)

	ifne	test
	move.b	#12,GaugeWidth(A5)
	endc

	ifeq	test

	suba.l	a1,a1
	jsr	_LVOfindtask(a6)
	move.l	d0,a4
	tst.l	$ac(a4)
	bne.w	clistart
	lea	$5c(a4),a0
	jsr	_LVOwaitport(a6)
	lea	$5c(a4),a0
	jsr	_LVOgetmsg(a6)
	move.l	d0,mess(a5)

	move.l	d0,a3
	tst.l	sm_numargs(a3)
	beq.s	.startprog		;Argumente übergeben ?

	move.l	sm_arglist(a3),a2
	move.l	wa_lock(a2),d3
	beq.s	.startprog		;kein Lock angegeben ?

	move.l	wa_name(a2),d4		;Name
	moveq	#0,d5
	bsr	GetIcon
.startProg
	move.l	4.w,a6
	jsr	_LVOforbid(a6)
	move.l	mess(a5),a1
	jsr	_LVOreplymsg(a6)
EndProg
	lea	dataslen(A5),a5
	unlk	a5
	ifeq	test
	rts
	else
	illegal
	endc
GetIcon
	moveq	#-1,d7
	
	lea	iconlib(pc),a1
	moveq	#0,d0
	jsr	_LVOopenlibrary(a6)
	tst.l	d0
	beq.w	.noicon
	move.l	d0,iconsave(a5)

	lea	doslib(pc),a1
	moveq	#0,d0
	jsr	_LVOopenlibrary(a6)
	tst.l	d0
	beq.w	.nodos
	move.l	d0,dos2(a5)		;Dosbase
	move.l	d0,a6

	tst.l	d5
	beq.s	.normal			;über Icon gestartet -> sonst Parameter holen

	jsr	_LVOgetProgramDIR(a6)
	move.l	d0,d3
	beq.w	.startprog

	lea	Finalbuffer(a5),a0
	move.l	a0,d1
	move.l	a0,d4
	moveq	#50,d2
	jsr	_LVOgetProgramName(a6)
	tst.l	d0
	beq.w	.startprog
.normal
	move.l	d3,d1
	jsr	_LVOcurrentdir(a6)	;Lock -> Currentdir
	move.l	d0,d6

	move.l	d4,a0			;Name
	move.l	iconsave(a5),a6
	jsr	_LVOgetdiskobject(a6)	;Icon suchen
	tst.l	d0
	beq.w	.noICON2
	move.l	d0,a2

	cmp.b	#WBTool,do_type(a2)	;Tool Icon ? 
	bne.w	.oops			;sollte nicht auftreten

	move.l	do_tooltypes(a2),a0
	lea	Argstring(pc),a1	;OutPutFormat finden
	jsr	_LVOfindtooltype(a6)
	tst.l	d0
	beq.s	.noArgString
	move.l	d0,a0
	lea	Argbuffer(a5),a1

	moveq	#99-1,d0
.arg
	move.b	(A0)+,(a1)+
	dbeq	d0,.arg
	clr.b	(a1)
.noArgString
	move.l	do_tooltypes(a2),a0
	lea	MemTypestring(pc),a1	;Gauge finden
	jsr	_LVOfindtooltype(a6)
	tst.l	d0
	beq.s	.nomemtype
	move.l	d0,a0
	cmp.b	#`0`,(a0)+
	bne.s	.nomemtype
	cmp.b	#`x`,(a0)+
	bne.s	.nomemtype
	moveq	#0,d0
.loopi
	move.b	(a0)+,d1
	beq.s	.end
	sub.b	#`0`,d1
	cmp.b	#9,d1
	bls.s	.lo1
	sub.b	#`A`-`9`-1,d1
.lo1
	cmp.b	#$f,d1
	bhi.s	.nomemtype

	lsl.l	#4,d0
	or.b	d1,d0
	bra.s	.loopi
.end
	move.l	d0,savememtype(a5)
.nomemtype
	move.l	do_tooltypes(a2),a0
	lea	Gaugestring(pc),a1	;Gauge finden
	jsr	_LVOfindtooltype(a6)
	tst.l	d0
	beq.s	.oops
	move.l	d0,a0
	move.b	(a0)+,d0
	beq.s	.oops
	sub.w	#`0`,d0
	cmp.b	#9,d0
	bhi.s	.oops
	
	move.b	(a0)+,d1
	beq.s	.end1
	sub.w	#`0`,d1
	cmp.b	#9,d1
	bhi.s	.oops
	mulu	#10,d0
	add.b	d1,d0
.end1
	move.b	d0,GaugeWidth(A5)
.oops
	move.l	a2,a0
	move.l	iconsave(a5),a6
	jsr	_LVOfreediskobject(a6)
.noICON2
	move.l	d6,d1
	move.l	dos2(a5),a6
	jsr	_LVOCurrentDir(A6)
.startprog
	move.l	4.w,a6
	move.l	dos2(a5),a1
	jsr	_LVOcloselibrary(a6)
	bsr.s	WBstart
	moveq	#0,d7
.nodos
	move.l	iconsave(a5),a1		;Iconlib
	move.l	4.w,a6
	jsr	_LVOcloselibrary(A6)
.noicon	move.l	d7,d0			;Return Value
	rts
Clistart:
	pea	EndProg(pc)
	st	d5
	bsr	GetIcon
	rts
	endc
WBstart:
	lea	Argbuffer(a5),a3		;Argumenttabelle
	tst.b	(a3)
	bne.s	.take
	lea	DefArguments(pc),a0
.copy
	move.b	(A0)+,(A3)+
	bne.s	.copy
.take
	bsr.b	OpenLibs		;Open Libraries
	beq.b	Error

	bsr.w	SetBroker		;Commodity init
	bne.b	Error

	bsr.w	InitRastport		;Rastport zum Anzeigen init
	beq.b	Error2

	bsr.w	Setint
.Mainloop
	move.l	4,a6
	move.l	#$1000,d0
	move.l	msgport(a5),d2
	beq.s	.nomsg
	move.l	d2,a0
	move.b	mp_sigbit(a0),d1
	bset	d1,d0
.nomsg
	move.l	mysignal(a5),d1
	bset	d1,d0
	jsr	_LVOwait(a6)
	move.w	d0,d1
	and.w	#$1000,d1
	bne.s	.end

	bsr.w	CheckMessage
	bne.s	.end
	bsr.w	Gettime
	beq.s	.waitagain
	bsr.w	Showtime
.waitagain
	bra.b	.Mainloop
.end
	bsr.w	SetRast
	moveq	#0,d6
	move.w	maxwidth(a5),d7
	bsr.w	ClearTitle

	move.l	commobase(a5),d0
	beq.s	Error2
	move.l	d0,a6
	move.l	brokerstruct(a5),a0
	jsr	_LVODeleteCxObjAll(a6)
Error2
	bsr.w	FreeRastPort		;Alle Resourcen zurückgeben
Error
	bsr.w	Remint
	bsr.w	CloseLibs
	moveq	#0,d0

	ifne	test
		illegal
	else
		rts
	endc
;========================== Libs öffnen =================================
OpenLibs:
	move.l	4,a6
	moveq	#-1,d0			;irgendein Signal
	jsr	_LVOallocsignal(a6)	;allokieren
	move.l	d0,mysignal(a5)		;merken
	blt.w	.error1

	suba.l	A1,A1
	JSR	_LVOfindtask(A6)	;Task finden
	move.l	d0,mytask(a5)

	lea	commodiname(pc),a1
	ifeq	use21
	moveq	#39,d0
	else
	moveq	#37,d0
	endc
	jsr	_LVOopenlibrary(a6)	;Commodities Library öffnen
	move.l	d0,Commobase(a5)
	beq.s	.nomsgport

	jsr	_LVOcreatemsgport(a6)
	move.l	d0,msgport(a5)
	beq.w	.Error1
.nomsgport
	lea	doslib(pc),a1
	jsr	_LVOoldopenlibrary(a6)
	move.l	d0,dos(A5)
	beq.b	.Error1

	lea	intlib(pc),a1
	jsr	_LVOoldopenlibrary(a6)
	move.l	d0,int(A5)
	beq.b	.Error1

	ifne	locale
	lea	loclib(pc),a1
	jsr	_LVOoldopenlibrary(a6)
	move.l	d0,loc(A5)
	beq.b	.Error1

	move.l	d0,a6
	suba.l	a0,a0
	jsr	_LVOopenlocale(A6)
	move.l	d0,mylocale(a5)
	beq.s	.Error1

	move.l	4.w,a6
	endc

	lea	utillib(pc),a1
	jsr	_LVOoldopenlibrary(a6)
	move.l	d0,util(A5)
	beq.b	.Error1

	lea	gfxlib(pc),a1
	jsr	_LVOoldopenlibrary(a6)
	move.l	d0,gfx(A5)
	beq.b	.Error1

	lea	timer(pc),a0		
	moveq	#UNIT_VBlank,d0		;oder UNIT_MICROHZ, ist aber egal
	lea.l	MyTimeVAL(A5),a1
	jsr	_LVOOpendevice(a6)
	tst.l	d0
	bne.b	.Error2
	lea.l	MyTimeVAL(A5),a1
	move.l	a1,IOREQ(A5)
	st	D0
.Error1
	rts
.Error2
	moveq	#0,d0
	rts
;========================== Libs schließen ==============================
CloseLibs:
	move.l	4,a6
	move.l	mysignal(a5),d0
	blt.s	.nosig
	jsr	_LVOfreesignal(a6)
.nosig
	move.l	IOReq(a5),d0
	beq.s	.noTIMER
	move.l	d0,a1
	jsr	_LVOclosedevice(A6)
	clr.l	IOReq(a5)
.noTIMER
	move.l	util(A5),d0
	beq.s	.noutil
	move.l	d0,a1
	jsr	_LVOcloselibrary(a6)
	clr.l	util(A5)
.noutil
	move.l	gfx(A5),d0
	beq.s	.nogfx
	move.l	d0,a1
	jsr	_LVOcloselibrary(a6)
	clr.l	gfx(A5)
.nogfx
	ifne	locale
	move.l	loc(A5),d0
	beq.s	.noloc
	move.l	d0,a6

	move.l	mylocale(a5),d0
	beq.s	.nolocale
	move.l	d0,a0
	jsr	_LVOcloselocale(A6)
.nolocale
	move.l	a6,a1
	move.l	4.w,a6
	jsr	_LVOcloselibrary(a6)
.noloc
	endc

	move.l	dos(A5),d0
	beq.s	.nodos
	move.l	d0,a1
	jsr	_LVOcloselibrary(a6)
	clr.l	dos(A5)
.nodos
	move.l	Int(A5),d0
	beq.s	.noint
	move.l	d0,a1
	jsr	_LVOcloselibrary(a6)
	clr.l	Int(A5)
.noint
	move.l	Commobase(a5),d0
	beq.s	.nocom
	move.l	d0,a1
	jsr	_LVOcloselibrary(a6)
.nocom
	move.l	msgport(a5),d0
	beq.s	.nomsg
	move.l	d0,a0
	jsr	_LVOdeletemsgport(a6)
.nomsg
	rts
;============ Test, ob Message an CommodityPort =========================
CheckMessage:
	move.l	4,a6
	move.l	msgport(a5),d0
	beq.s	.ok
	move.l	d0,a0
	jsr	_LVOgetmsg(a6)
	tst.l	d0
	beq.b	.ok			;;
				;Warten auf Hotkey/Message vom Exchange Programm
	move.l	d0,a4
	move.l	d0,a0
	move.l	Commobase(a5),a6
	jsr	_LVOcxmsgtype(a6)

	cmp.l	#cxm_command,d0
	bne.b	.reply
	move.l	a4,a0
	jsr	_LVOcxmsgid(a6)

	cmp.l	#cxcmd_unique,d0	;Programm zum 2.Male aufgerufen ?
	beq.b	.endit			
	cmp.l	#cxcmd_kill,d0		;Beenden ?
	beq.b	.endit
	cmp.l	#cxcmd_disable,d0	;Deaktivieren ?
	bne.s	.nodis
	moveq	#0,d0
	bra.s	.acti
.nodis
	cmp.l	#cxcmd_enable,d0	;Aktivieren ?
	bne.s	.reply
	moveq	#1,d0
.acti
	move.b	d0,enabled(A5)
	move.l	brokerstruct(a5),a0
	jsr	_LVOactivatecxobj(a6)	;Broker (de)aktivieren
.reply
	move.l	4.w,a6
	move.l	a4,a1
	jsr	_LVOreplymsg(a6)

	tst.b	enabled(A5)
	bne.s	.ok

	bsr.w	SetRast
	moveq	#0,d6
	move.w	maxwidth(a5),d7
	bsr.w	ClearTitle
.ok
	moveq	#0,d0
	rts
.endit
	move.l	4.w,a6
	move.l	a4,a1
	jsr	_LVOreplymsg(a6)
	moveq	#-1,d0
	rts
;======================== Commodity anmelden =============================
SetBroker
	tst.l	msgport(a5)
	beq.s	.nomsg

	move.l	commobase(a5),a6

	lea	mybroker(a5),a0
	move.b	#nb__version,nb_version(a0)
	lea	commoname(pc),a1
	move.l	a1,nb_name(a0)
	lea	Commotitle(pc),a1
	move.l	a1,nb_title(a0)
	lea	commoaha(pc),a1
	move.l	a1,nb_descr(a0)
	move.w	#nbu_notify!nbu_unique,nb_unique(a0)
	move.b	#0,nb_pri(a0)	;Priorität setzen (entfällt->siehe WBstartup)
	move.l	msgport(a5),a1
	move.l	a1,nb_port(a0)

	lea	fehler(a5),a1
	move.l	a1,d0
	jsr	_LVOCxBroker(a6)	;Broker init

	tst.l	fehler(a5)
	bne.b	.remport
	move.l	d0,brokerstruct(A5)

	move.l	d0,a0
	moveq	#1,d0
	jsr	_LVOactivatecxobj(a6)	;Broker aktivieren

	moveq	#0,d0
.remport
.nomsg
	rts
*************************************************************
*       Setzt Interrupt für Scroller (VBlank)               *
*************************************************************
Setint	
	move.l	4.w,a6
	lea	inter(a5),a1
	lea	INT_Prog(pc),a0
	move.l	a0,IS_code(a1)
	move.l	a5,is_data(a1)
	move.b	#nt_interrupt,ln_type(a1)
	moveq	#5,d0
	jsr	_LVOaddintserver(a6)
	st	intset(A5)
	rts
*************************************************************
*         entfernt Scroller-Interrupt                       *
*************************************************************
Remint
	tst.b	intset(a5)
	beq.s	.no
	move.l	4.w,a6
	moveq	#5,d0
	sf	intset(a5)
	lea	inter(a5),a1
	jsr	_LVOremintserver(a6)
.no	rts
*************************************************************
*                  VBLANK Interrupt                         *
*************************************************************
INT_Prog
	movem.l	d0-a6,-(sp)
	move.b	counter(A1),d0
	addq.b	#1,d0
	and.b	#15,d0
	move.b	d0,counter(A1)
	bne.s	.ret

	move.l	4.w,a6
	move.l	mysignal(A1),d1
	move.l	mytask(A1),a1
	moveq	#0,d0
	bset	d1,d0
	jsr	_LVOsignal(a6)
.ret
	movem.l	(sp)+,d0-a6
	moveq	#0,d0
	rts
;============================ HexDezRoutine =============================
ToDEZ2						;2 Stellen (01)
	movem.l	d0-a3,-(Sp)
	and.l	#$ff,d1		;sicher gehen
	moveq	#1,d0
	lea	dectable2(pc),a1
	bra.s	Indez
ToDEZ						;4 Stellen (1994)
	movem.l	d0-a3,-(Sp)
	moveq	#3,d0
	lea	dectable4(pc),a1
Indez
	moveq	#0,d4
.loopw
	moveq	#-1,d3
	move.l	-(a1),d2
.loopw2
	addq.b	#1,d3
	sub.l	d2,d1
	bcc.s	.loopw2
	add.l	d2,d1
	add.b	#`0`,d3
	move.b	d3,(a4)+
	dbf	d0,.loopw
	movem.l	(sp)+,d0-a3
	rts
;= holt aktuelle Systemzeit und legt diese entsprechend in den Merkzellen ==
;=========================== als Normalzeit ab =============================
GetTime
	moveq	#0,d0
	tst.b	enabled(A5)
	beq.s	.skip

	move.l	4,a6
	move.l	IOREQ(a5),a1
	move.w	#TR_getsystime,28(a1)	
	jsr	_LVOdoio(a6)

	move.l	IOREQ(a5),a1
	move.l	iotv_time(a1),d0
	cmp.l	lasttime(a5),d0
	beq.s	.skip
	move.l	d0,lasttime(A5)

	move.l	util(a5),a6
	lea	MyDate(a5),a0
	jsr	_LVOAmiga2Date(A6)
	st	d0
.skip
	rts
SetRast
	lea.l	MyRastPort(a5),a1
	moveq	#0,d0
	move.b	mybg(a5),d0
	move.l	gfx(A5),a6
	jmp	_LVOsetrast(a6)
;================= Routine zum Anzeigen der aktuellen Zeit =================
ShowTime
	tst.l	MyFont(A5)		;kein Rastport zu haben
	beq.w	.error1			;-> Raus

	bsr.b	SetRast
	
	lea	Argbuffer(a5),a3		;Argumenttabelle
	lea	Finalbuffer(A5),a4		;Puffer für den Text
.Showloop
	move.b	(a3)+,d0
	beq.w	.Displayit
	cmp.b	#`%`,d0
	beq.s	.DoPercent
.Jumpin
	move.b	d0,(a4)+
	bra.s	.Showloop
.DoPercent
	move.b	(a3)+,d0		;Zeichen nach dem "%" holen
	cmp.b	#`%`,d0
	beq.s	.jumpin

	cmp.b	#`#`,d0
	beq	.doWeeknumber

	cmp.b	#`S`,d0
	beq	.doStardate

	cmp.b	#`H`,d0
	bne.s	.no12h
	move.w	MyDate+hour(a5),d1
	beq.s	.do12
	cmp.b	#12,d1
	ble.s	.lo
	sub.b	#12,d1
.lo
	bra	.dec
.do12
	moveq	#12,d1
	bra	.dec
.no12h
	move.w	MyDate+hour(a5),d1
	cmp.b	#`h`,d0
	beq.w	.dec

	cmp.b	#`a`,d0			;AM/PM
	bne.s	.noampm
	ifne	locale
	move.w	d1,d4
	moveq	#AM_STR,d1
	cmp.w	#12,d4
	blt.s	.nopm
	addq.w	#PM_STR-AM_STR,d1
.nopm
	bra.w	.addlocstring
	else
	lea	myAM(pc),a1
	cmp.w	#12,d1
	blt.s	.nopm
	addq.l	#myPM-myam,a1
.nopm
	bra	.copyday
	endc
.noampm
	move.w	MyDate+min(a5),d1
	cmp.b	#`n`,d0
	beq.s	.dec

	move.w	MyDate+sec(a5),d1
	cmp.b	#`s`,d0
	beq.s	.dec

	move.w	MyDate+mday(a5),d1
	cmp.b	#`D`,d0
	beq.s	.dec

	move.w	MyDate+month(a5),d1
	cmp.b	#`N`,d0
	beq.s	.dec

	move.w	MyDate+year(a5),d1
	cmp.b	#`y`,d0
	bne.s	.noyear1
	divu	#100,d1
	swap	d1
	bra.s	.dec
.noyear1
	cmp.b	#`Y`,d0
	bne.s	.noyear
	bsr.w	todez
	bra.w	.Showloop
.noyear
	moveq	#0,d1
	move.w	MyDate+wday(a5),d1

	ifeq	locale
	ifeq	deutsch
	mulu	#10,d1
	else
	mulu	#11,d1
	endc
	lea	Daynames(pc),a1
	lea	(a1,d1.w),a1
	cmp.b	#`w`,d0
	beq.s	.WeekShort
	cmp.b	#`W`,d0
	beq.s	.Weekday

	move.w	MyDate+month(a5),d1
	subq.w	#1,d1
	mulu	#10,d1
	lea	MonthNames(pc),a1
	lea	(a1,d1.w),a1

	cmp.b	#`m`,d0
	beq.s	.WeekShort
	cmp.b	#`M`,d0
	beq.s	.Weekday
	else

	addq.w	#DAY_1,d1
	cmp.b	#`W`,d0
	beq.s	.addlocstring
	addq.w	#ABDAY_1-DAY_1,d1
	cmp.b	#`w`,d0
	beq.s	.addlocstring

	move.w	MyDate+month(a5),d1
	add.w	#MON_1-1,d1
	cmp.b	#`M`,d0
	beq.s	.addlocstring
	add.w	#ABMON_1-MON_1,d1
	cmp.b	#`m`,d0
	beq.s	.addlocstring

	endc

	bra.w	.Showloop
.dec:
	bsr.w	toDez2
	bra.w	.Showloop
.WeekShort						;Wochentag
	move.b	(a1)+,(a4)+
	move.b	(a1)+,(a4)+
	move.b	(a1)+,(a4)+
	bra.w	.Showloop
.addlocstring
	move.l	mylocale(a5),a0
	move.l	loc(a5),a6
	move.l	d1,d0
	jsr	_LVOgetlocalestr(A6)
	move.l	d0,a1
.Weekday						;Wochentag lang
.copyday
	move.b	(a1)+,(a4)+
	bne.s	.copyday
	subq.l	#1,a4
	bra.w	.Showloop
.doWeekNumber
	move.l	util(a5),a6
	lea	MyTmpDate(a5),a0
	clr	sec(a0)
	clr	min(a0)
	clr	hour(a0)
	move	#1,mday(a0)	
	move	#1,month(a0)
	move	MyDate+year(a5),year(a0)
	clr	wday(a0)
	jsr	_LVODate2Amiga(A6)
	lea	MyTmpDate(a5),a0
	jsr	_LVOAmiga2Date(A6)

	moveq	#0,d2
	move	MyTmpDate+wday(a5),d2
	bne.s	.weekok
	move	#7,d2
.weekok
	addq	#5,d2				;= 1. Woche

	move.w	MyDate+Month(a5),d1
	cmp.b	#2,d1				;Januar/Februar ?
	ble.s	.noschalt			;ja -> weiter

	move	MyDate+year(a5),d0		;Jahr holen
	move	#1976,d3			;Referenz
	sub	d3,d0
	and	#3,d0				;Differenz durch 4 teilbar -> Schaltjahr
	bne.s	.noschalt
	addq	#1,d2				;bei März-Dezember im Schaltjahr ein Tag drauf
.noschalt
	lea	Monthtable(pc),a0
	add	d1,d1
	move	-2(a0,d1),d1		;+ vergangene Tage der letzten Monate
	add	d1,d2		
	add	MyDate+mday(a5),d2	;+ Tage im aktuellen Monat
	divu	#7,d2			;durch 7 Tage pro Woche
	and.l	#$ffff,d2
	move.l	d2,d1
	bsr	todez2
	bra	.Showloop
.doStardate
	move.b	#`0`,(a4)+
	move.l	lasttime(A5),D1
	divu	#60*60*3,d1	;3 Stunden statt 24 für 8-fache Genauigkeit
	mulu	#100,d1		;mal 100 wegen 365,25 Tagen Pro Jahr und Integerrechnung
	lsr.l	#3,d1		;durch 8 (jetzt darf man)
	divu.w	#36525,d1	;365,25*100
	swap	d1		;Rest=Tage im aktuellen Jahr
	and.l	#$ffff,d1	;ausmaskieren

	lsl.l	#6,d1		;für höhere Genauigkeit links shiften
	divu.w	#365*100<<6/1000,d1	;durch 100, mal 1000 und durch 365
	and.l	#$ffff,d1	;ausmaskieren
	bsr	todez		;4 Stellen printen

	move.w	MyDate+year(a5),d1
	sub.w	#1990,d1
	cmp.w	#9,d1
	bhi.s	.skipye
	add.b	#`0`,d1
	move.b	d1,-4(a4)
.skipye
	move.b	#$2e,(a4)+

	move.w	MyDate+hour(a5),d1
	mulu.w	#10,d1
	divu.w	#24,d1
	addi.b	#`0`,d1
	move.b	d1,(a4)+
	bra	.showloop
.Displayit

	clr.b	(a4)
.repeat
	lea	Finalbuffer(A5),a0		;Puffer für den Text
	move.l	a0,a3
	moveq	#-1,d0
.loop						;darf ich, da ja vorher gerade
	addq.l	#1,d0				;clr.b (a4), also 100%ig
	tst.b	(a3)+				;terminiert
	bne.s	.loop
	subq.l	#2,a3				;-1 = Null-Byte; -2 = Byte davor

	move.l	d0,d6				;Länge des Textes in Chars
	lea	myrastport(A5),a1
	move.l	gfx(A5),a6
	jsr	_LVOtextlength(A6)
	move.l	d0,d7				;Länge des Textes in Pixeln

	add.w	#28,d0				;Breite des Depth-Gadgets
	cmp.w	LastWidth(A5),d0		;Text breiter als Screen ?
	blt.s	.lower
	clr.b	(a3)
	bra.s	.repeat
.lower
	cmp.w	MaxWidth(a5),d7
	blt.s	.nomax
	move.w	d7,MaxWidth(A5)
.nomax
	moveq	#0,d4
	move.b	GaugeWidth(A5),d4
	beq.w	.nogauge
	mulu	#10,d4
	add.w	d4,d0
	add.w	#20,d0
	cmp.w	LastWidth(A5),d0		;Text breiter als Screen ?
	bge.w	.noGauge			;Überspringen

	move.b	#` `,1(A3)
	ifeq	deutsch
	move.b	#`E`,2(A3)
	else
	move.b	#`L`,2(A3)
	endc
	clr.b	3(a3)
	addq.w	#2,d6
	move.l	d6,d0
	lea	Finalbuffer(A5),a0		;Puffer für den Text
	lea	myrastport(A5),a1
	jsr	_LVOtextlength(A6)
	move.l	d0,d7
	addq.l	#6,d7
	move.l	d7,xpos(a5)
	add.l	d4,d7
	addq.l	#6,d7
	move.l	d7,d5

	lea	MyF(pc),a0			;Puffer für den Text
	lea	myrastport(A5),a1
	moveq	#1,d0
	jsr	_LVOtextlength(A6)
	add.l	d0,d7

	lea	myrastport(A5),a1
	moveq	#0,d0
	jsr	_LVOSetAPen(A6)

	lea	myrastport(A5),a1
	move.l	xpos(a5),d0
	addq.w	#2,d0
	moveq	#0,d1
	move.w	d4,d2
	add.w	d0,d2
	move.w	MyAttr+ta_YSize(A5),d3		;Höhe der Zeile
	subq.w	#2,d3
	jsr	_LVORectFill(A6)

	move.l	4.w,a6
	move.l	#MEMF_TOTAL,d1
	add.l	SaveMEMtype(A5),d1	;alles, was frei ist
	jsr	_LVOAvailMem(A6)
	move.l	d0,AvailMem(a5)

	move.l	4.w,a6
	move.l	SaveMEMtype(A5),d1	;alles, was frei ist
	jsr	_LVOAvailMem(A6)
	move.l	d0,FreeMem(a5)
	beq.s	.skip2nd

	move.l	util(A5),a6
	lsr.l	#8,d0
	move.l	d4,d1			;Max. Balkenbreite
	jsr	_LVOUMult32(A6)

	move.l	AvailMem(a5),d1
	lsr.l	#8,d1
	jsr	_LVOUDivMod32(a6)
	sub.l	d0,d4			;aktuelle Balkenbreite

	move.l	gfx(A5),a6
	lea	myrastport(A5),a1
	moveq	#3,d0
	jsr	_LVOSetAPen(A6)

	lea	myrastport(A5),a1
	clr.w	rp_flags(A1)

	move.l	xpos(a5),d0
	addq.w	#2,d0
	moveq	#1,d1
	move.w	d4,d2
	add.w	d0,d2
	move.w	MyAttr+ta_YSize(A5),d3		;Höhe der Zeile
	subq.w	#3,d3
	jsr	_LVORectFill(A6)
.skip2nd
	move.l	gfx(A5),a6
	lea	myrastport(A5),a1
	moveq	#0,d0
	move.b	myfg(a5),d0
	jsr	_LVOSetAPen(A6)

	lea.l	MyRastPort(a5),a1
	move.l	d5,d0
	move.l	MyFont(a5),a0
	move.w	tf_Baseline(a0),d1
	jsr	_LVOMove(A6)

	lea.l	MyRastPort(a5),a1
	lea	myf(pc),a0		;Puffer für den Text
	moveq	#1,d0
	jsr	_LVOtext(A6)

	cmp.w	MaxWidth(a5),d7
	blt.s	.nomax2
	move.w	d7,MaxWidth(A5)
	bra.s	.error1
.nomax2
.nogauge
	addq.w	#6,d7
.error1
ClearTitle:
	bsr.w	LockPub
	beq.b	.Error1

	bsr.b 	CheckRast		;Test, ob sich der Screen geändert
					;hat

	tst.l	MyFont(A5)		;kein Rastport zu haben
	beq.b	.dofree			;-> Raus

	move.l	gfx(A5),a6

	ifne	locklayer
	move.l	a5,-(sp)
	move.l	d0,a5
	move.l	sc_BarLayer(a5),a5
	jsr	_LVOlocklayerrom(a6)
	move.l	(sp)+,a5
	endc

	lea.l	MyRastPort(a5),a1
	moveq	#6,d0
	move.l	MyFont(a5),a0
	move.w	tf_Baseline(a0),d1
	jsr	_LVOMove(A6)

	lea.l	MyRastPort(a5),a1
	lea	Finalbuffer(A5),a0		;Puffer für den Text
	move.l	d6,d0
	jsr	_LVOtext(A6)

	lea.l	MyRastPort(a5),a0
	moveq	#0,d0
	moveq	#0,d1

	move.l	mypub(a5),a1
	move.l	sc_BarLayer(a1),a1
	move.l	lr_rp(a1),a1

	move.w	LastWidth(A5),d2
	sub.w	#28,d2
	sub.w	d7,d2

	moveq	#1,d3				;DestY

	move.l	d7,d4				;Breite des Ganzen
	move.w	MyAttr+ta_YSize(A5),d5		;Höhe der Zeile
	move.l	#$c0,d6
	jsr	_LVOclipblit(a6)

	ifne	locklayer
	move.l	a5,-(sp)
	move.l	mypub(a5),a5
	move.l	sc_BarLayer(a5),a5
	jsr	_LVOunlocklayerrom(a6)
	move.l	(sp)+,a5
	endc
.dofree
	bsr.w	FreePub
.Error1
	rts
;================== Test, ob der Screen sich geändert hat ==================
CheckRast
	movem.l	d0-a6,-(sp)
	move.l	mypub(A5),a0
	move.w	Lastwidth(a5),d0
	cmp.w	sc_Width(a0),d0
	bne.s	.new

	move.b	LastDepth(A5),d0
	cmp.b	sc_BitMap+bm_depth(a0),d0
	bne.s	.new

	move.l	sc_BarLayer(a0),a0
	move.l	lr_rp(a0),a0
	move.l	rp_Font(a0),d0
	move.l	d0,a0
	cmp.l	LastFont(A5),d0
	bne.s	.new

	move.w	tf_YSize(a0),d0
	cmp.w	MyAttr+ta_YSize(a5),d0
	bne.s	.new	
	move.b	tf_Flags(a0),d0
	cmp.b	MyAttr+ta_Flags(a5),d0
	beq.s	.end
.new
	bsr.w	FreeRastPort		;Alle Resourcen zurückgeben

;	bsr	InitRastport		;Rastport zum Anzeigen init
;statt dessen Direktaufruf
	bsr.w	DupFont		;in D5 Höhe des Screenfonts zurück
	bsr.w	InitRastandBit
	bsr	Setrast
.end
	movem.l	(sp)+,d0-a6
	rts
;================ temporären Rastport für Anzeige einrichten ===============
InitRastport:
	bsr.b	LockPub
	beq.b	.Error1

	bsr.b	DupFont		;in D5 Höhe des Screenfonts zurück
	bsr.w	InitRastandBit
				;wenn hier Änderungen, dann auch oben !!
;	beq	.Error2
;.Error2

	bsr.b	FreePub
.Error1
	tst.l	d0
	rts
LockPub
	move.l	int(a5),a6
	jsr	_LVOlockpubscreenlist(a6)
	tst.l	d0
	beq.s	.danndoch
	move.l	d0,a0
	lea	WBName(pc),a2

	move.l	lh_Head(A0),a0
.lop
	tst.l	(A0)			;Liste Leer ?
	beq.s	.lassma
					;also 1. Node
	move.l	ln_name(a0),a1
	moveq	#wbname_size-1,d0	;Namenslänge
	move.l	a2,a3			;zu suchender Name
.all
	cmpm.b	(a3)+,(a1)+
	bne.s	.next
	dbf	d0,.all
	bra.s	.unlock
.next
	move.l	ln_succ(a0),a0
	bra.s	.lop
.unlock
	jsr	_LVOunlockpubscreenlist(A6)
.danndoch
	lea	WBName(pc),a0
	jsr	_LVOLockpubscreen(A6)
	move.l	d0,mypub(a5)
	rts
.lassma
	jsr	_LVOunlockpubscreenlist(A6)
	moveq	#0,d0
	rts
FreePub
	movem.l	d0-a6,-(sp)
	move.l	int(a5),a6
	move.l	mypub(a5),d0
	beq.s	.nopub
	move.l	d0,a1
	suba.l	a0,a0
	jsr	_LVOUnlockpubscreen(A6)
	clr.l	mypub(A5)
.nopub
	movem.l	(sp)+,d0-a6
	rts
DupFont
	move.l	mypub(a5),a0
	ifne	use21
	move.b	#0,myfg(a5)
	move.b	#1,mybg(a5)
	else
	move.b	#1,myfg(a5)
	move.b	#2,mybg(a5)
	endc

	move.l	int(A5),a6
	jsr	_LVOGetScreenDrawinfo(a6)
	tst.l	d0
	beq.s	.lo
	move.l	d0,a1
	cmp.w	#BARBLOCKPEN,dri_numpens(a1)
	blt.s	.lo2
	move.l	dri_pens(a1),d0
	beq.s	.lo2
	move.l	d0,a0
	move.w	BARDETAILPEN*2(a0),d0
	move.b	d0,myfg(A5)
	move.w	BARBLOCKPEN*2(a0),d0
	move.b	d0,mybg(A5)
.lo2
	move.l	mypub(a5),a0
	jsr	_LVOFreeScreenDrawinfo(A6)
.lo
	move.l	mypub(a5),a0
	move.l	sc_BarLayer(a0),a0
	move.l	lr_rp(a0),a0
	move.l	rp_Font(a0),a0
	move.l	a0,LastFont(A5)

	lea	MyAttr(A5),a1
	move.b	tf_Style(a0),ta_Style(a1)
	move.b	tf_Flags(a0),ta_Flags(a1)
	move.w	tf_YSize(a0),ta_YSize(a1)

	lea	Fontname(a5),a3
	move.l	a3,ta_name(A1)
	move.l	LN_Name(a0),a2

	moveq	#30,d0
.copy
	move.b	(A2)+,(A3)+
	dbeq	d0,.copy
	rts
InitRastandBit
	move.l	mypub(a5),a1
	lea	sc_BitMap(a1),a0
	moveq	#0,d2
	move.b	bm_Depth(a0),d2
	move.b	d2,LastDepth(A5)

	moveq	#0,d0
	move.w	sc_Width(a1),d0
	move.w	d0,Lastwidth(a5)

	moveq	#0,d1
	move.w	MyAttr+ta_YSize(A5),d1		;Höhe des Fonts

	ifne	use21
	bsr	AllocBitMap
	bne.s	.error1
	else
	moveq	#0,d3
	move.l	gfx(A5),a6
	jsr	_LVOAllocbitmap(a6)
	move.l	d0,MyBitmap(A5)
	beq.b	.error1
	endc

	lea.l	MyRastPort(a5),a3
	move.l	a3,a1
	jsr	_LVOInitrastport(A6)

	move.l	MyBitMap(a5),d0
	move.l	d0,rp_BitMap(a3)

	lea	MyAttr(A5),a0
	jsr	_LVOOpenFont(A6)
	move.l	d0,MyFont(a5)
	beq.s	.Error1

	move.l	a3,a1
	move.l	d0,a0
	jsr	_LVOSetFont(A6)

	move.l	a3,a1
	moveq	#0,d0
	move.b	myfg(a5),d0
	jsr	_LVOSetAPen(A6)

	move.l	a3,a1
	moveq	#0,d0
	move.b	mybg(a5),d0
	jsr	_LVOSetBPen(A6)

	move.l	a3,a1			;Rastport
	move.l	#RP_JAM2,d0
	jsr	_LVOsetDrMd(A6)
	st	d0
.error1	rts

FreeRastPort
	move.l	gfx(A5),a6

	ifne	use21
	bsr	Freebitmap
	else
	move.l	MyBitmap(A5),d0
	beq.s	.noBit
	move.l	d0,a0
	jsr	_LVOFreebitmap(a6)
	clr.l	MyBitmap(a5)
.NoBit
	endc

	move.l	MyFont(a5),d0
	beq.s	.nofont
	move.l	d0,a1
	jsr	_LVOCloseFont(A6)
	clr.l	MyFont(A5)
.nofont
	rts
	ifne	use21
AllocBitMap
	move.l	gfx(A5),a6

	lea	MY_Bitmap(A5),a3
	move.l	a3,MyBitmap(A5)

	lea	(a3),a0
	lea	bm_planes(A3),a3
	lea	(a3),a1
	moveq	#7,d5
.clr	clr.l	(a1)+
	dbf	d5,.clr

	move.w	d0,d3		;Breite (Pix)
	add.w	#16,d3
	and.w	#~15,d3

	moveq	#0,d0
	move.b	d2,d0		;Tiefe (Bits)

	move	d2,-(sp)
	moveq	#0,d2
	move.w	d1,d2		;Höhe
	move.w	d1,d4
	moveq	#0,d1
	move.w	d3,d1		;Breite (Pix)

	jsr	_LVOinitbitmap(A6)
	move	(sp)+,d2

	subq.w	#1,d2
.allplanes
	move.w	d3,d0
	move.w	d4,d1
	addq.w	#1,d1
	jsr	_LVOallocraster(A6)
	move.l	d0,(A3)+
	beq.s	.fail
	move.l	d0,a0	;;!!
	move.l	#1,(a0)
	dbf	d2,.allplanes
	moveq	#0,d0
	rts
.fail
	moveq	#-1,d0
	rts
FreeBitmap
	move.l	gfx(A5),a6

	lea	MY_Bitmap(A5),a3
	moveq	#0,d2
	move.b	bm_depth(a3),d2
	subq.w	#1,d2

	move.w	bm_bytesperrow(a3),d3
	lsl.w	#3,d3
	lea	bm_planes(A3),a4
.allplanes
	move.w	d3,d0
	move.w	bm_rows(a3),d1
	move.l	(a4),d4
	beq.s	.noplane
	move.l	d4,a0
	addq.w	#1,d1
	jsr	_LVOfreeRaster(A6)
.noplane
	clr.l	(a4)+
	dbf	d2,.allplanes
	rts
	endc
;================================ Daten =================================
DefArguments
	dc.b	`%# %w %D.%m.%Y %h:%n:%s %a`,0

	;%h	-> Stunden (10)
	;%n	-> Minuten (33)
	;%s	-> Sekunden (12)
	;%D	-> Tag	(12)
	;%N	-> Monat als Zahl (01)
	;%y	-> Jahr kurz (94)
	;%Y	-> Jahr (1994)
	;%w	-> Wochentag kurz (Fri)
	;%W	-> Wochentag lang (Friday)
	;%m	-> Monat kurz (Jan)
	;%M	-> Monat (January)
	;%H	-> Stunden im 12h Format
	;%a	-> AM/PM
	;%S	-> Stardate (für Algo, siehe  DOC)
	;%#	-> Wochennummer im laufenden Jahr

	even
	dc.l	1
	dc.l	10
dectable2
	dc.l	100
	dc.l	1000
dectable4
;	dc.l	10000
;	dc.l	100000
;	dc.l	1000000
;	dc.l	10000000
;Dectable8

;Summen der Anzahl der Tage vom Januar bis Monat X, Schaltjahr hier nicht berücksichtigt
Monthtable:
	dc.w	0
	dc.w	31					;Januar
	dc.w	31+28					;Februar
	dc.w	31+28+31				;März
	dc.w	31+28+31+30				;April
	dc.w	31+28+31+30+31				;Mai
	dc.w	31+28+31+30+31+30			;Juni
	dc.w	31+28+31+30+31+30+31			;Juli
	dc.w	31+28+31+30+31+30+31+31			;August
	dc.w	31+28+31+30+31+30+31+31+30		;September
	dc.w	31+28+31+30+31+30+31+31+30+31		;Oktober
	dc.w	31+28+31+30+31+30+31+31+30+31+30	;November
;	dc.w	31+28+31+30+31+30+31+31+30+31+30+31	;Dezember

	dc.b	`$VER: Titleclock 1001 `
	ver

	if	Kickversion=37
	dc.b	` OS2.04`
	else

	if	Kickversion=38
	dc.b	` OS2.1`
	else
	dc.b	` OS3.x`
	endc

	endc

	dc.b	` (`
	date
	dc.b	`) © Buggs/DEFECT`,0

commoname:	dc.b	`TitleClock 1001 V`
		ver
		dc.b	0


	ifne	locale
loclib		dc.b	`locale.library`,0
	endc
commodiname:	dc.b	`commodities.library`,0
doslib:		dc.b	`dos.library`,0
intlib:		dc.b	`intuition.library`,0
utillib		dc.b	`utility.library`,0
gfxlib		dc.b	`graphics.library`,0
timer:		dc.b	`timer.device`,0
iconlib:	dc.b	`icon.library`,0

Argstring	dc.b	`Outputformat`,0
Gaugestring	dc.b	`Gauge`,0
Memtypestring	dc.b	`Memtype`,0
WBName	dc.b	"Workbench",0
wbname_size=*-wbname

	ifeq	deutsch
MyF	dc.b	`F`,0

Commotitle:	dc.b	`© 1994 Henryk Richter,`,0
commoaha:	dc.b	`one more Workbench Titleclock`,0

	ifeq	locale
myAM	dc.b	`AM`,0
myPM	dc.b	`PM`,0

Daynames
	dc.b	`Sunday`,0,0,0,0
	dc.b	`Monday`,0,0,0,0
	dc.b	`Tuesday`,0,0,0
	dc.b	`Wednesday`,0
	dc.b	`Thursday`,0,0
	dc.b	`Friday`,0,0,0,0
	dc.b	`Saturday`,0,0
MonthNames
	dc.b	`January`,0,0,0
	dc.b	`February`,0,0
	dc.b	`March`,0,0,0,0,0
	dc.b	`April`,0,0,0,0,0
	dc.b	`May`,0,0,0,0,0,0,0
	dc.b	`June`,0,0,0,0,0,0
	dc.b	`July`,0,0,0,0,0,0
	dc.b	`August`,0,0,0,0
	dc.b	`September`,0
	dc.b	`October`,0,0,0
	dc.b	`November`,0,0
	dc.b	`December`,0,0
	endc

	else

MyF	dc.b	`V`,0

Commotitle:	dc.b	`© 1994 Henryk Richter,`,0
commoaha:	dc.b	`noch eine Workbench Titeluhr`,0

	ifeq	locale
myAM	dc.b	`vorm.`,0
myPM	dc.b	`nachm.`,0

Daynames
	dc.b	`Sonntag`,0,0,0,0
	dc.b	`Montag`,0,0,0,0,0
	dc.b	`Dienstag`,0,0,0
	dc.b	`Mittwoch`,0,0,0
	dc.b	`Donnerstag`,0
	dc.b	`Freitag`,0,0,0,0
	dc.b	`Samstag`,0,0,0,0
MonthNames
	dc.b	`Januar`,0,0,0,0
	dc.b	`Februar`,0,0,0
	dc.b	`März`,0,0,0,0,0,0
	dc.b	`April`,0,0,0,0,0
	dc.b	`Mai`,0,0,0,0,0,0,0
	dc.b	`Juni`,0,0,0,0,0,0
	dc.b	`Juli`,0,0,0,0,0,0
	dc.b	`August`,0,0,0,0
	dc.b	`September`,0
	dc.b	`Oktober`,0,0,0
	dc.b	`November`,0,0
	dc.b	`Dezember`,0,0
	endc

	endc

	rsreset
mess:		rs.l	1
mylocale	rs.l	1
loc:		rs.l	1
Commobase	rs.l	1
dos		rs.l	1
dos2		rs.l	1
int		rs.l	1
util		rs.l	1
gfx		rs.l	1
IOREQ		rs.l	1
MyTimeVAL	rs.b	IOTV_Size
MyDate		rs.b	cd_size
MytmpDate	rs.b	cd_size 	;für Wochentagberechnung des 1. Januar im aktuellen Jahr
MyPub		rs.l	1
MyAttr		rs.b	ta_sizeof
MyBitMap	rs.l	1
MyRastport	rs.b	rp_SIZEOF
MyFont		rs.l	1
LastFont	rs.l	1
LastWidth	rs.w	1
LastDepth	rs.b	1
Finalbuffer	rs.b	200+1
Argbuffer	rs.b	100
Fontname	rs.b	32
myfg		rs.b	1
mybg		rs.b	1
lasttime	rs.l	1
mysignal	rs.l	1
mytask		rs.l	1
Intset		rs.b	1
Counter		rs.b	1
iconsave	rs.l	1
msgport		rs.l	1
fehler		rs.l	1
brokerstruct	rs.l	1
inter:		rs.l	2
		rs.b	1	;2
		rs.b	1	;127
		rs.l	3

	ifne	use21
my_bitmap	rs.b	bm_sizeof
rastdepth	rs.w	1
rastwidth	rs.w	1
rastheight	rs.w	1
	endc
MyBroker:	rs.b	newbroker_sizeof
MaxWidth	rs.w	1
Enabled		rs.b	1
GaugeWidth	rs.b	1
AvailMem	rs.l	1
FreeMem		rs.l	1
SaveMEMtype	rs.l	1
xpos		rs.l	1
dataslen	rs.b	0
;		section	1,bss
;datas:	
;		ds.b	dataslen
