* Kammera
* (c) Jens M�ller 1993


	output	.ACC

VBASEHI		equ	$FF8201
VBASEMID	equ	$FF8203
VSHIFTMODE	equ	$FF8260
VCOLOR00	equ	$FF8240


	include TOSDEF.S
	include	AESDEF.S


	text

	lea	mystack,sp

	call_gemdos Dgetdrv		* Pfad ermitteln
	addq.l	#2,sp
	move.b	d0,d1
	add.b	#'A',d1
	lea	path(pc),a4
	move.b	d1,(a4)+
	move.b	#':',(a4)+
	addq.w	#1,d0
	move.w	d0,-(sp)
	move.l	a4,-(sp)
	call_gemdos Dgetpath
	addq.l	#8,sp
	move.l	a4,a1			* Extension anh„ngen
	lea	extens(pc),a0
	bsr	strcat

	move.l	#screen+255+34,d0	* Bildzwischenspeicher
	clr.b	d0			* auf 256-Byte-Grenze
	sub.l	#34,d0			* wegen Degas-Format
	move.l	d0,pic_ptr

	call_xbios Getrez
	addq.l	#2,sp
	move.l	pic_ptr(pc),a0
	move.w	d0,(a0)

	pea	install
	call_xbios Supexec
	addq.l	#6,sp

	appl_init
	move.w	d0,ap_id

	menu_register ap_id,#mymenu

wait_for_event
	evnt_mesag #mbuf
	cmp.w	#AC_OPEN,mbuf
	bne.s	wait_for_event
alert	form_alert #1,#myalert
	cmp.w	#2,d0
	bne.s	evnt1

	call_xbios Physbase	* intern gespeichertes Bild anschauen
	addq.l	#2,sp		* durch umschalten des Bildspeichers
	move.l	d0,phys_scr	* auf das interne Bild

	move.w	#-1,-(sp)		* Aufl”sung gleich
	move.l	pic_ptr,d0
	add.l	#34,d0
	move.l	d0,-(sp)		* phys. Bildspeicher
	move.l	#-1,-(sp)		* log. Bildspeicher
	call_xbios Setscreen
	lea	12(sp),sp

	call_gemdos Crawcin		* auf Tastendruck warten
	addq.l	#2,sp

	move.w	#-1,-(sp)		* Bild zur�ckschalten
	move.l	phys_scr,-(sp)
	move.l	#-1,-(sp)
	call_xbios Setscreen
	lea	12(sp),sp
	bra	wait_for_event

evnt1	cmp.w	#3,d0
	bne	wait_for_event
	bsr	save_pic
	bra	wait_for_event


* Hardcopy-Vektor verbiegen
install	move.l	scr_dump,oldhardcopyvec
	move.l	#newhardcopy,scr_dump
	rts


	data

mymenu	dc.b	'  Camera ST 1.0',0
myalert	dc.b	'[0][ ----- CAMERA ST 1.0 ------'
	dc.b	' |    (c) Jens M�ller 1993 |'
	dc.b	' | ALT-HELP takes the picture | ]'
	dc.b	'[Cancel|View|Save]',0
extens	dc.b	'\*.PI?',0


		bss

path		ds.b	128
		even
ap_id		ds.w	1
mbuf		ds.w	8
phys_scr	ds.l	1
pic_ptr		ds.l	1
		ds.l	100
mystack		ds.l	1


		include AESLIB.S


*** neue Hardcopy-Routine *********************************

* das aktuelle Bild wird intern zwischengespeichert

	text

	dc.b	'XBRA'
	dc.b	'CAME'
oldhardcopyvec
	ds.l	1
newhardcopy
	movem.l	d0/a0-a1,-(sp)
	move.l	pic_ptr(pc),a1
	move.b	VSHIFTMODE,d0		* Aufl”sung
	and.w	#$3,d0
	move.w	d0,(a1)+
	move.l	#VCOLOR00,a0		* Farbpalette
	moveq.w	#15,d0
hc_co	move.w	(a0)+,(a1)+
	dbf	d0,hc_co
	clr.l	d0			* Bilddaten
	move.b	VBASEHI,d0
	lsl.l	#8,d0
	move.b	VBASEMID,d0
	lsl.l	#8,d0
	move.l	d0,a0
	move.w	#15999,d0		* Gesamtanzahl Worte - 1
hc_lp	move.w	(a0)+,(a1)+
	dbf	d0,hc_lp
	movem.l	(sp)+,d0/a0-a1
	rts


*** Bild sichern ******************************************

	text

save_pic
	lea	wrname(pc),a0
	lea	filename(pc),a1
	bsr	strcpy
	subq.l	#2,a1			* zeigt auf Fragezeichen
	move.l	pic_ptr(pc),a0
	move.w	(a0),d0			* entsprechend Aufl”sung
	add.b	#'1',d0			* Extension „ndern
	move.b	d0,(a1)			* PI1...PI3

	fsel_input #path,#filename
	tst.w	d0
	beq	save_end		* Fehler
	move.w	int_out+2,d0
	beq	save_end		* Abbruch
	tst.b	filename
	beq	save_end		* leerer Dateiname

	lea	path(pc),a0		* vollen Namen ermitteln
	lea	fullname(pc),a1
	move.l	a1,a3
	bsr	strcpy
	move.l	a3,a1			* letzen Backslash suchen
	subq.l	#1,a3
find_last
	addq.l	#1,a3
	tst.b	(a3)
	beq.s	find_end
	cmp.b	#'\',(a3)
	bne.s	find_last
	move.l	a3,a1
	bra.s	find_last
find_end
	addq.l	#1,a1			* Dateiname anh„ngen
	lea	filename(pc),a0
	bsr	strcpy

	clr.w	-(sp)			* Ausgabefile kreieren
	pea	fullname(pc)
	call_gemdos Fcreate
	addq.l	#8,sp
	cmp.w	#-5,d0
	blt.s	save_err
	move.w	d0,d3

	move.l	#32034,d4		* Anz. zu schreibende Bytes
	move.l	pic_ptr,-(sp)		* File schreiben
	move.l	d4,-(sp)
	move.w	d3,-(sp)
	call_gemdos Fwrite
	lea	$C(sp),sp
	move.l	d0,d5			* Anz. geschriebene Bytes merken

	move.w	d3,-(sp)		* File schliežen
	call_gemdos Fclose
	addq.l	#4,sp

	cmp.l	d4,d5			* alle Bytes geschrieben?
	beq.s	save_end		* ja

save_err
	form_alert #1,#save_alert
save_end
	rts


	data

wrname	dc.b	'CAMERA.PI?',0
save_alert	dc.b	"[3][ Can't write file!][ Cancel ]",0


		bss

fullname	ds.b	128
filename	ds.b	14


*** Grundroutinen *****************************************

	text

* String a0 an a1 anh„ngen bzw kopieren
strcat	tst.b	(a1)+
	bne.s	strcat
	subq.l	#1,a1
strcpy	move.b	(a0)+,(a1)+
	bne.s	strcpy
	rts


*** Bildzwischenspeicher **********************************

		bss

screen		ds.b	32256+34	* wegen Degas-Format


*** Ende **************************************************

	END

***********************************************************