; ***********************************************************
; *                                                         *
; * P L A T I N U M - D I S P L A Y - R E P L A C E M E N T *
; *                                                         *
; *                        V 1.00                           *
; *                                                         *
; ***********************************************************
; *                                                         *
; *          Assembler-Source / Assembler: Devpac II        *
; *                                                         *
; *                    (C)April 1991 by                     *
; *                                                         *
; *                    Joerg Schliesser                     *
; *                  Platinum-Softwareline                  *
; *                   Rotenwaldstrasse 20                   *
; *                   D-7000 Stuttgart 1                    *
; *                         Germany                         *
; *                                                         *
; ***********************************************************

; *** Amiga OS-Routinen ***

	; Exec-Library
AllocMem	=	-198
FreeMem		=	-210
FindTask	=	-294
GetMsg		=	-372
ReplyMsg	=	-378
WaitPort	=	-384
CloseLibrary	=	-414
OpenLibrary	=	-552

	; Dos-Library
Open		=	-30
Close		=	-36
Read		=	-42
Lock		=	-84
UnLock		=	-90
DupLock		=	-96
Examine		=	-102
CurrentDir	=	-126
Delay		=	-198

	; Intuition-Library
ClearPointer	=	-60
CloseScreen	=	-66
CloseWindow	=	-72
DrawImage	=	-114
OpenScreen	=	-198
OpenWindow	=	-204
PrintIText	=	-216
RefreshGadgets	=	-222
SetPointer	=	-270

	; Graphics-Library
SetRast		=	-234
SetRGB4		=	-288
RectFill	=	-306
SetAPen		=	-342
InitBitMap	=	-390
AllocRaster	=	-492
FreeRaster	=	-498
ScrollVPort	=	-588

; assembler-options

	section	programm,code	;1st section, code, public_mem

; check WB- or CLI-start and get WB-startup-message

start:
	move.l	sp,startsp	;save stackpointer 
	move.l	a0,memo1	;cli textpointer
	move.w	d0,memo2	;cli textlength
	move.l	4,a6
	suba.l	a1,a1		;get adress of pltdisplay-task
	jsr	FindTask(a6)
	move.l	d0,thistask

	lea	dosname,a1
	moveq	#0,d0
	jsr	OpenLibrary(a6)	;open dos_lib
	move.l	d0,dosbase
	beq	quitpltdisplay

	lea	graphname,a1
	moveq	#0,d0
	jsr	OpenLibrary(a6)	;open graph_lib
	move.l	d0,graphbase
	beq	quitpltdisplay

	lea	intuiname,a1
	moveq	#0,d0
	jsr	OpenLibrary(a6)	;open intui_lib
	move.l	d0,intuibase
	beq	quitpltdisplay

	move.l	#1024,d0
	move.l	#$10003,d1
	jsr	AllocMem(a6)	;get infomem (for fileinfoblock etc.)
	move.l	d0,infomem
	beq	quitpltdisplay

	move.l	thistask,a4	;pointer to task-struct
	tst.l	$ac(a4)		;started from CLI ?
	beq	wbstart

; get filename if started from CLI

	move.l	memo1,a0	;text-pointer
	move.w	memo2,d0	;text-length
	subq.w  #1,d0		;no text ?
	beq	nofile		;well then ... waiting
lforname:
	cmpi.b	#$20,(a0)+	;look for 'space'
	bne	foundname	;no space ... got beginning of filename
	dbra	d0,lforname
	bra	nofile		;no space ... no filename !
foundname:
	subq.l	#1,a0		;got filename
getfilename:
	lea	filename,a1	;adress of memory for filename
	cmp.b	#34,(a0)	;drop " - char at the beginning
	beq	dropfirst
	cmp.b	#39,(a0)	;drop ' - char at the beginning
	bne	copyname
dropfirst:
	adda.l	#1,a0
copyname:			;copy filename
	move.b	(a0)+,d1
	beq	eofname		;zero => end
	cmp.b	#10,d1
	beq	eofname		;linefeed => end
	cmp.b	#13,d1
	beq	eofname		;carriag return => end
	move.b	d1,(a1)+
	bra	copyname
eofname:
	clr.b	(a1)		;zero-byte to end filename
	move.l	a1,a0		;keep end of filename
	cmp.b	#34,-(a1)	;drop " - char at the end
	beq	droplast
	cmp.b	#39,(a1)	;drop ' - char at the end
	bne	lookparam
droplast:
	clr.b	(a1)
lookparam:
	suba.l	#4,a0 
	cmp.b	#44,(a0)	;look for ','
	beq	gotparam
	adda.l	#1,a0
	cmp.b	#44,(a0)
	bne	gotfilename	;no ',' ... no parameter
gotparam:
	move.b	1(a0),d0	;get type of parameter
	move.b	2(a0),d1	;get one digit of parameter
	move.b	3(a0),d2	;get onother digit of the parameter
	clr.b	(a0)+
	clr.b	(a0)+		;delete paramter from filename
	clr.b	(a0)+
	clr.b	(a0)
	cmp.b	#35,d0		;look for '#' to indicate repeat-parameter
	beq	gotrepeatparam
	cmp.b	#38,d0		;look for '&' to indicate time-parameter
	bne	gotfilename	;(here there's no difference between # and &)
gotrepeatparam:
	tst.b	d2		;is there only one digit ?
	bne	twodigits
	sub.b	#48,d1
	move.b	d1,time		;get value of parameter and save it
	bra	gotfilename
twodigits:
	moveq	#0,d3
	sub.b	#48,d1
	sub.b	#48,d2		;get value of two-digit parameter
	mulu	#10,d1
	move.b	d1,d3
	add.b	d2,d3		;and save it
	move.b	d3,time
	bra	gotfilename

; get parameters if programm is started from wb

wbstart:
	lea	$5c(a4),a0	;pointer to task's message-port 
	jsr	Waitport(a6)	;wait for wb-start-message
	lea	$5c(a4),a0
	jsr	GetMsg(a6)	;get wb-start-message
	move.l	d0,startmsg
	beq	nofile		;no message ? ... strange !
	move.l	d0,a0
	cmp.l	#1,$1c(a0)	;number of arguments < 1 ... nofilename
	bls	nofile
	move.l	$24(a0),a2	;pointer to list of segments (picked icons)
	beq	nofile		;... very strange !
	move.l	8(a2),d1	;pointer to directory of text(?)-icon
	beq	noselectdir
	move.l	dosbase,a6
	jsr	CurrentDir(a6)	;actual dir => new dir
	move.l	d0,d1
	beq	noselectdir
	jsr	UnLock(a6)
noselectdir:
	move.l	12(a2),d0	;pointer to filename
	beq	nofile		;... no filename !
	move.l	d0,a0
	tst.b	(a0)		;get first character of filename
	beq	nofile		;... still very strange !
	bra	getfilename	;well then get the filename

; well ... now we open the window !

nofile:
	bset	#0,pltflag
gotfilename:
	move.l	intuibase,a6
	lea	wplt,a0		;open display-window
	jsr	OpenWindow(a6)
	move.l	d0,wdwhandle	;keep wdwhandle
	beq	quitpltdisplay
	move.l	d0,a0
	move.l	50(a0),wdwrast	;keep rastport
	bsr	dowindow	;draw the wonderful pltdisplay-window
	btst	#0,pltflag
	bne	waitmessage	;did we get one file to start ?

; now we load one picture (?) - file

gotloadfile:
	bsr	pltworkon	;set 'working-pointer'
	bsr	droppicscreen
	lea	filename,a0	;filename-pointer
	move.l	#$10001,d0	;type of memory: public/clear
	bsr	loadfile	;one file-load-routine
	move.l	d0,long		;keep length of data
	beq	exitshowpic	;data length = 0 ... really very strange !
	move.l	a0,iffmem	;data-adress-pointer
	bsr	dowindow	;and redisplay the window

; get memory for bitplanes, open screen and display picture

	move.l	iffmem,a2
	move.l	long,d0
	cmp.l	#"ILBM",8(a2)	;look if this really is on IFF-Picture
	bne	exitshowpic
	lsr.l	#1,d0		;length of file /2 as counter
lookbmhd:
	cmp.l	#"BMHD",(a2)
	beq	foundbmhd	;look for bitmap-header-chunk
	adda.l	#2,a2
	subq.l	#1,d0
	bne	lookbmhd
	bra	exitshowpic
foundbmhd:
	bclr	#0,flags	;nohires
	bclr	#1,flags	;unpacked
	adda.l	#4,a2
	lea	screen,a0
	lea	tx2,a1	
	clr.w	12(a0)		;ViewModes
	move.w	#200,6(a0)	;screen-height: 200 ???
	move.l	#"200 ",18(a1)
	move.w	6(a2),height	;picture-height
	cmp.w	#200,6(a2)
	bls	gotheight
	move.l	graphbase,a6
	cmp.w	#1,206(a6)	;NTSC-mode ???
	beq	ntscmode
	move.w	#256,6(a0)	;screen-height: 256 ???
	move.l	#"256 ",18(a1)
	cmp.w	#256,6(a2)
	bls	gotheight	;if not then ...
ntscmode:
	or.w	#4,12(a0)	;ViewMode: Interlace
	move.w	#400,6(a0)
	move.l	#"400 ",18(a1)	;screen-height: 400 ???
	cmp.w	#400,6(a2)
	bls	gotheight
	cmp.w	#1,206(a6)	;NTSC-mode ???
	beq	gotheight
	move.w	#512,6(a0)	;if not then ...
	move.l	#"512 ",18(a1)	;screen-height: 512 !!!
gotheight:
	move.w	#320,4(a0)	;screen-width: 320 ???
	move.l	#"320 ",12(a1)
	move.w	4(a2),width	;picture-width
	cmp.w	#320,4(a2)
	bls	gotwidth	;in not then ...
	move.w	#640,4(a0)
	move.l	#"640 ",12(a1)	;screen-width: 640 !!!
	bset	#0,flags	;and ...
	or.w	#$8000,12(a0)	;ViewMode: HiRes
gotwidth:
	moveq	#0,d0
	move.b	12(a2),d0	;get depth of picture
	move.w	d0,8(a0)
	move.w	d0,depth
	add.b	#48,d0
	move.b	d0,31(a1)	;display depth in PLTDisplay-Window
	tst.b	14(a2)
	beq	unpacked	;get packed/unpacked-flag
	bset	#1,flags
unpacked:
	move.l	iffmem,a2
	move.l	long,d0
	lsr.l	#1,d0		;look if there is on CAMG-chunk
lookcamg:
	cmp.l	#"CAMG",(a2)
	beq	foundcamg
	adda.l	#2,a2
	subq.l	#1,d0
	bne	lookcamg
	bra	nocamg
foundcamg:			;if yes... then get
	adda.l	#8,a2		;ViewModes out if CAMG-chunk 
	move.l	(a2),d0		;but also keep ('or') ViewModes
	or.w	d0,12(a0)	;based on picture-dimensions
nocamg:
	cmp.w	#4,depth	;if depth is larger than 4
	bls	dontworrymodes
	move.w	12(a0),d0	;kill hires-bit in viewmodes
	bclr	#15,d0
	move.w	d0,12(a0)	;and width has to be 320
	move.w	#320,4(a0)
	move.l	#"320 ",12(a1)
dontworrymodes:
	moveq	#0,d5		;get width of bitplanes
	move.w	width,d5
	move.w	4(a0),pwidth	;if the picture is smaller
	cmp.w	pwidth,d5
	bls	gotpwidth	;than the the screen the bitplane 
	divu	#16,d5
	move.l	d5,d3		;is as large as the screen, if not
	lsr.l	#8,d3
	lsr.l	#8,d3		;well then ... the bit plane is
	tst.w	d3
	beq	equalpwidth	;as large as the picture but it also
	addq.w	#1,d5
equalpwidth:			;has to be a multiple of 16 (or ???)
	asl.l	#4,d5
	move.w	d5,pwidth
gotpwidth:
	moveq	#0,d5
	move.w	height,d5	;get height of bitplanes
	move.w	6(a0),pheight
	cmp.w	pheight,d5	;(philosophy... see above)
	bls	gotpheight
	move.w	d5,pheight		
gotpheight:
	move.l	graphbase,a6
	lea	bitmap,a0
	move.w	depth,d0	;init BitMap-struct
	move.w	pwidth,d1
	move.w	pheight,d2
	jsr	InitBitMap(a6)
	move.w	depth,d5
	subq.w	#1,d5
	lea	planes,a5	;pointer to table of bplanes
	lea	bitmap,a4	;pointer to bplanes in bmap-struct
	adda.l	#8,a4
getplanes:
	move.w	pwidth,d0	;get memory for all bplanes
	move.w	pheight,d1
	jsr	AllocRaster(a6)
	tst.l	d0
	beq	exitshowpic
	move.l	d0,(a5)+	;and save the bplane-adresses
	move.l	d0,(a4)+
	dbra	d5,getplanes
	move.l	intuibase,a6
	lea	screen,a0	;and finaly open the screen
	jsr	OpenScreen(a6)
	move.l	d0,iffscreen	;keep screen-handle
	beq	exitshowpic	;no screen ... no picture
	move.l	d0,clscr
	add.l	#44,d0
	move.l	d0,iffview	;keep pointer to screen-viewport
	lea	wscrclose,a0
	jsr	OpenWindow(a6)	;open 'close'-window on pic-screen
	move.l	d0,wscrclosehl
	move.l	graphbase,a6
	move.l	iffscreen,a1
	adda.l	#84,a1		;pointer to screen-rastport
	moveq	#0,d0
	jsr	SetRast(a6)	;fill rastport with color 0
	move.l	iffmem,a2
	move.l	long,d0
	lsr.l	#1,d0
lforcolchunk:
	cmp.l	#"CMAP",(a2)	;look for CMAP-chunk in iff-file
	beq	foundcolch
	adda.l	#2,a2
	subq.l  #1,d0
	bne	lforcolchunk
	bra	nocolorchunk
foundcolch:
	move.l	graphbase,a6	;iff there is one color-chunk in
	adda.l	#4,a2
	move.l	(a2)+,d4
	divu	#3,d4
	subq.w	#1,d4		;the iff-file...
	moveq	#0,d5
setcolchloop:
	move.l	iffview,a0
	move.l	d5,d0
	moveq	#0,d1
	moveq	#0,d2
	moveq	#0,d3		;then restore all the
	move.b	(a2)+,d1
	lsr.b	#4,d1
	move.b	(a2)+,d2
	lsr.b	#4,d2		;wonderfull colors
	move.b	(a2)+,d3
	lsr.b	#4,d3
	jsr	SetRGB4(a6)
	addq.l	#1,d5
	dbra	d4,setcolchloop
nocolorchunk:
	moveq	#0,d0
	moveq	#0,d1
	move.w	width,d0	;get width in bytes
	divu	#8,d0
	move.w	d0,d1
	lsr.l	#8,d0
	lsr.l	#8,d0
	tst.w	d0
	beq	equalwidth1
	addq.w	#1,d1
equalwidth1:
	move.l	d1,d0
	divu	#2,d0		;and width in bytes HAS TO BE (???)
	lsr.l	#8,d0
	lsr.l	#8,d0		;equal (I am really not sure !)
	tst.w	d0
	beq	equalwidth2
	addq.w	#1,d1
equalwidth2:
	move.w	d1,widthbytes
	move.l	iffmem,a6
	move.l	long,d0
	lsr.l	#1,d0
lforpbody:
	cmp.l	#"BODY",(a6)	;look for body-chunk
	beq	foundpbody
	adda.l	#2,a6
	subq.l	#1,d0
	bne	lforpbody
	bra	exitshowpic
foundpbody:
	adda.l	#8,a6		;begin of body-chunk
	moveq	#0,d7
	move.w	height,d7
	subq.w	#1,d7		;number of lines as counter
	moveq	#0,d6
setpiloop1:
	moveq	#0,d5
	move.w	depth,d5	;number of planes as counter for
	subq.l	#1,d5		;inner loop
	lea	bitmap,a0
	adda.l	#8,a0		;pointer to table of bitmap-pointers
setpiloop2:
	move.l	(a0),a1		;get adress of first bitmap
	move.l	d6,d0		;number of actual line
	moveq	#0,d1
	move.w	pwidth,d1
	lsr.w	#3,d1		;* bytes per display-line
	mulu	d1,d0
	adda.l	d0,a1		;= pointer to actual line
	moveq	#0,d4
	move.w	widthbytes,d4	;width in bytes as counter for
	subq.w	#1,d4		;main loop
setpiloop3:
	btst	#1,flags	;is this picture packed ???
	bne	packeddata
	move.b	(a6)+,(a1)+	;well then ... easy going
	dbra	d4,setpiloop3
	bra	nextsetplane
packeddata:
	moveq	#0,d0
	move.b	(a6)+,d0	;read next data-byte
	cmp.b	#$80,d0		;is this one no-option-fill-byte ???
	bne	nonoopbyte	;no ... then look what is it for
	subq.l	#1,d4
	bmi	nextsetplane	;go on ...
	bra	setpiloop3
nonoopbyte:
	tst.b	d0
	bpl	setunpacked	;next d0-bytes are unpacked
	neg.b	d0		;neg d0 to get number of equal bytes
	move.b	(a6)+,d1	;read the byte
setpacked:
	move.b	d1,(a1)+	;write byte into bitplane
	subq.l	#1,d4		;sub byte-counter
	bmi	nextsetplane	;negative counter => line is ready
	dbra	d0,setpacked	;go on writing the same byte
nextsetpack:
	tst.l	d4		;positive counter => read next byte
	bpl	setpiloop3
	bra	nextsetplane	;ready line ... same line, next plane
setunpacked:
	move.b	(a6)+,(a1)+	;copy unpacked bytes in bplane
	subq.l	#1,d4
	bmi	nextsetplane	;count down the counter
	dbra	d0,setunpacked
	bra	nextsetpack	;and go on reading the data
nextsetplane:
	adda.l	#4,a0		;pointer to next plane
	dbra	d5,setpiloop2
	addq.l	#1,d6		;number of line plus 1
	dbra	d7,setpiloop1
exitshowpic:
	bsr	pltworkoff	;drop work-pointer
	bsr	dowindow	;display the PLTDisplay-window

; waiting for user-interaction

waitmessage:
	tst.b	time
	beq	noparadrive
	move.l	dosbase,a6	;look if there was a parameter
	moveq	#0,d1
	move.b	time,d1		;delivered, when the programm was
	mulu	#50,d1
	jsr	Delay(a6)	;started
	bra	quitpltdisplay
noparadrive:
	move.l	4,a6		;is there is a picture-screen, with a
	tst.l	wscrclosehl	;little close-window in the upper left
	bne	twowindows
	move.l	wdwhandle,a0
	move.l	86(a0),a0	;window-user-port
	jsr	WaitPort(a6)	;waiting for intuimessage
	bra	nodroppic
twowindows:
	move.l	wscrclosehl,a0	;look if 'close'-window was activated
	move.l	86(a0),a0	;window user-port
	jsr	GetMsg(a6)	;get intuimessage
	tst.l	d0
	beq	nodroppic	;no activation ... go on
	move.l	d0,a1
	jsr	ReplyMsg(a6)
	bsr	droppicscreen	;close picture-screen and drop memory
	bra	waitmessage
nodroppic:
	move.l	wdwhandle,a0
	move.l	86(a0),a0	;window user-port
	jsr	GetMsg(a6)	;get intuimessage
	tst.l	d0
	beq	waitmessage	;there wasn't one ... stra...
	move.l	d0,a1
	move.l	20(a1),d6	;get idcmp-code of event
	move.l	28(a1),a3	;get (possibly) adress of gadget
	move.w	24(a1),d5	;get (possibly) raw-key-code	
	move.w	26(a1),d4	;get (possibly) qualifier
	jsr	ReplyMsg(a6)	;and reply message
	cmp.l	#$40,d6
	bne	noupgadgetmsg	;wasn't any gadget at all
	cmpa.l	#gdgquit,a3	;quit this wonderfull programm ?
	beq	quitpltdisplay
	cmpa.l	#gdgload1,a3	;request for new file to laod ?
	beq	gotloadfile
	cmpa.l	#gdghelp,a3	;request for help-window ?
	bne	waitmessage
	bsr	plthelp
	bra	waitmessage
noupgadgetmsg:			;no gadget... that means a key ;-)
	cmp.w	#$4e,d5
	beq	scrollright	;'CRSR ->' - scroll display right
	cmp.w	#$4f,d5
	beq	scrollleft	;'CRSR <-' - scroll display left
	cmp.w	#$4c,d5
	beq	scrollup	;'CRSR up' - scroll display up
	cmp.w	#$4d,d5
	beq	scrolldown	;'CRSR dn' - scroll display down
	cmp.w	#$45,d5
	beq	quitpltdisplay	;'esc' - quit programm ?
	cmp.w	#$5f,d5
	bne	waitmessage
	bsr	plthelp		;'Help' - show help window
	bra	waitmessage

; close a picture-screen and free picture-memory

droppicscreen:
	move.l	intuibase,a6
	tst.l	wscrclosehl	;look if there is a 'close'-window
	beq	nooldwclose
	move.l	wscrclosehl,a0	;and close it
	jsr	CloseWindow(a6)
	clr.l	wscrclosehl
nooldwclose:
	tst.l	iffscreen	;look if there still is a screen
	beq	nooldscreen
	move.l	iffscreen,a0
	jsr	CloseScreen(a6)	;if yes, then close it
	clr.l	iffscreen
	bsr	freeplanes	;and free bitplane-memory
nooldscreen:
	move.l	4,a6
	move.l	iffmem,a1
	move.l	long,d0
	beq	nooldsongmem
	jsr	FreeMem(a6)	;free old data memory
	clr.l	iffmem		;and clear pointers
	clr.l	long
nooldsongmem:
	rts

; scroll disply if dimensions of picture are larger than screen

scrollright:
	bsr	getoffsets	;get actual offsets
	add.w	d0,d2
	cmp.w	pwidth,d2	;look if there is something to show
	bge	waitmessage	;on the right
	move.w	pwidth,d4
	sub.w	d2,d4
	cmp.w	#32,d4		;scroll-right a maximum of 32 pixels
	bls	gotscrright
	move.w	#32,d4
gotscrright:
	add.w	d4,d0
	bra	doscroll

scrollleft:
	bsr	getoffsets
	tst.w	d0
	beq	waitmessage
	move.w	d0,d4
	cmp.w	#32,d4		;see above
	bls	gotscrleft
	move.w	#32,d4
gotscrleft:
	sub.w	d4,d0
	bra	doscroll

scrolldown:
	bsr	getoffsets
	add.w	d1,d3
	cmp.w	pheight,d3
	bge	waitmessage
	move.w	pheight,d5
	sub.w	d3,d5
	cmp.w	#32,d5		;see above
	bls	gotscrdown
	move.w	#32,d5
gotscrdown:
	add.w	d5,d1
	bra	doscroll
scrollup:
	bsr	getoffsets
	tst.w	d1
	beq	waitmessage
	move.w	d1,d5
	cmp.w	#32,d5		;see above
	bls	gotscrup
	move.w	#32,d5
gotscrup:
	sub.w	d5,d1
	bra	doscroll

getoffsets:
	move.l	iffscreen,a0
	move.w	12(a0),d2	;width of screen
	move.w	14(a0),d3	;height of screen
	adda.l	#80,a0
	move.l	(a0),a1
	move.w	8(a1),d0	;left offset
	move.w	10(a1),d1	;top offset
	rts

doscroll:
	move.w	d0,8(a1)	;write new left offset
	move.w	d1,10(a1)	;write new top offset
	move.l	graphbase,a6
	move.l	iffview,a0
	jsr	ScrollVPort(a6)	;remake viewport-display
	bra	waitmessage

; quit this wonderfull program ...

quitpltdisplay:
	move.l	intuibase,a6
	tst.l	wdwhandle
	beq	nowdwclose
	move.l	wdwhandle,a0	;close the wonderfull PLTDisplay-Window
	jsr	CloseWindow(a6)
nowdwclose:	
	bsr	droppicscreen	;close the picture-screen
	move.l	4,a6
	tst.l	dosbase
	beq	nodropdos
	move.l	dosbase,a1
	jsr	CloseLibrary(a6)	;close dos_lib
nodropdos:
	tst.l	graphbase
	beq	nodropgraph
	move.l	graphbase,a1
	jsr	CloseLibrary(a6)	;close graph_lib
nodropgraph:
	tst.l	intuibase
	beq	nodropintui
	move.l	intuibase,a1
	jsr	CloseLibrary(a6)	;close intui_lib
nodropintui:
	tst.l	infomem
	beq	nodropinfomem
	move.l	#1024,d0
	move.l	infomem,a1
	jsr	FreeMem(a6)	;drop infomem
nodropinfomem:
	tst.l	startmsg
	beq	quitpltdisplayprog
	move.l	startmsg,a1	;if there is an wb-start-message
	jsr	ReplyMsg(a6)	;reply it
quitpltdisplayprog:
	moveq	#0,d0
	moveq	#0,d1
	move.l	startsp,sp
	rts			;and ... that's the end of pltdisplay

; free memory for bitplanes

freeplanes:
	move.l	graphbase,a6
	moveq	#5,d5		;free a maximum of 6 bitplanes
	lea	planes,a5
freeploop:
	move.l	(a5),d0		;was this the last plane ???
	beq	exitplanefree
	move.l	d0,a0
	move.w	pwidth,d0
	move.w	pheight,d1
	jsr	FreeRaster(a6)	;free memory
nextplanefree:
	clr.l	(a5)+
	dbra	d5,freeploop
exitplanefree:
	rts

; loadfile-routine, gets length of file, allocates mem and finally loads it

loadfile:
	movem.l	d1-d7/a1-a6,-(sp)
	move.l	a0,a5		;keep pointer to filename
	move.l	d0,d5		;keep mem-type
	move.l	dosbase,a6
	move.l	a5,d1
	moveq	#-2,d2		;lock-mode = -2 ... read !
	jsr	Lock(a6)	;get filelock
	move.l	d0,d7		;keep pointer to filelock
	beq	lerror1		;no lock ... error !
	move.l	dosbase,a6
	move.l	d7,d1		;filelock
	move.l	infomem,d2	;info-memory
	jsr	Examine(a6)	;examine file-info-data
	tst.l	d0		;d0 = 0 ? ... Error !
	beq	lerror1
	move.l	d7,d1		;drop filelock
	jsr	UnLock(a6)
	move.l	infomem,a3
	move.l	124(a3),d0	;get length of file
	addq.l	#2,d0		;we want some zero-bytes at the end
	move.l	4,a6
	move.l	d5,d1		;get requested mem-type
	jsr	AllocMem(a6)	;allocate memory
	move.l	d0,a2		;keep memory-pointer
	tst.l	d0		;no memory ... error !
	beq	lerror1
	move.l	a5,d1		;filename-pointer
	move.l	#1005,d2	;open-mode: old
	move.l	dosbase,a6
	jsr	Open(a6)	;open file
	move.l	d0,d4		;keep filehandle
	beq	lerror1		;filehandle = 0 ? ... error !
	move.l	d0,d1
	move.l	a2,d2		;memory-pointer
	move.l	124(a3),d3	;length of file
	jsr	Read(a6)	;read file
	move.l	d4,d1
	jsr	Close(a6)	;close file
	move.l	124(a3),d4	;keep length of file
	addq.l	#2,d4		;we still want some zero-bytes at the end
	move.l	a2,a0		;data-pointer in a0
	move.l	d4,d0		;length of data in d0
exitloadfile:
	movem.l	(sp)+,d1-d7/a1-a6
	rts			;we are ready !
lerror1:
	moveq	#0,d0		;d0 = 0 ... that means one error
	bra	exitloadfile	;and we are ready too !

; get ascii out of integer (textpointer => a0, integer => d0)

getascii:
	moveq	#16,d1
	divu	#1000,d0	;digit of thousands
	addi.b	#48,d0		;get ascci-code
	move.b	d0,(a0)+
	lsr.l	d1,d0		;keep the rest
	divu	#100,d0		;digit of hundreds
	addi.b	#48,d0
	move.b	d0,(a0)+	;and so on ...
	lsr.l	d1,d0
	divu	#10,d0
	addi.b	#48,d0
	move.b	d0,(a0)+
	lsr.l	d1,d0
	addi.b	#48,d0
	move.b	d0,(a0)+
	rts

; display the wonderfull pltdisplay-help-window

plthelp:
	move.l	intuibase,a6
	lea	wabout,a0	;open help-window
	jsr	OpenWindow(a6)
	move.l	d0,d7		;keep wdwhandle
	beq	quitplthelp	;no window ! ... that's unbeliveable
	move.l	graphbase,a6
	move.l	d7,a1
	move.l	50(a1),a1
	moveq	#2,d0		;set pen to color 2
	jsr	SetAPen(a6)
	move.l	d7,a1
	move.l	50(a1),a1
	moveq	#2,d0		;rect allmost the whole window
	moveq	#1,d1
	move.w	#537,d2
	move.w	#188,d3
	jsr	RectFill(a6)
	move.l	intuibase,a6
	moveq	#20,d3		;y-pos of first line
	lea	helptx,a5	;pointer to help-lines
	moveq	#16,d5		;20 lines to print
plthelploop1:
	lea	texttext,a4	;memory for text-line
	moveq	#-1,d6		;counter for length to pre-zero
plthelploop2:
	addq.w	#1,d6		;count one more character
	move.b	(a5)+,(a4)+	;copy it
	bne	plthelploop2	;not zero ... go on copying
	asl.w	#3,d6		;8 points per char 
	move.w	#540,d0		;width of window
	sub.w	d6,d0		;sub width of text
	lsr.w	#1,d0		;and divide through 2 to center
	move.l	d7,a0
	move.l	50(a0),a0	;window-rastport
	lea	textline,a1	;text-struct
	move.b	#2,1(a1)	;set background-color to color 2
	move.l	d3,d1		;get y-pos
	jsr	PrintIText(a6)	;and print the line
	add.w	#9,d3		;add 9 to y-pos
	dbra	d5,plthelploop1	;and go on printing
	lea	textline,a1	;as the same text-struct is used to display
	clr.b	1(a1)		;the 'real' text reset back-col to 0
	bclr	#2,pltflag	;clear flag (see below for the sense of it)
plthelpwait:
	move.l	4,a6
	move.l	d7,a0
	move.l	86(a0),a0	;window-user-port
	jsr	WaitPort(a6)	;wait for message ... task is sleeping
	move.l	d7,a0
	move.l	86(a0),a0
	jsr	GetMsg(a6)	;now ... there's one user-request !
	tst.l	d0
	beq	plthelpwait	;no ...there's none ... (...strange!)
	move.l	d0,a1
	move.l	20(a1),d6	;get idcmp of message-cause
	jsr	ReplyMsg(a6)	;and send message back
	cmp.l	#$8,d6		;did the user (got bless him/her)
	beq	helpmousepick	;press one mouse-button ?
	btst	#2,pltflag	;drop the first key, which possibly opened
	bne	helpmousepick	;the window (a strange way to avoid that
	bset	#2,pltflag	;the window is closed at once if it was
	bra	plthelpwait	;called with the help-key)
helpmousepick:
	move.l	intuibase,a6
	move.l	d7,a0
	jsr	CloseWindow(a6)	;well ... close the help-window, o.k. ???
quitplthelp:
	rts

; display the wonderfull pltdisplay-window

dowindow:
	lea	screen,a1
	lea	tx3,a0
	move.l	#"    ",36(a0)	;clear 'type of picture'
	move.w	12(a1),d0
	btst	#7,d0
	beq	noehb
	move.l	#"EHB ",36(a0)	;one extra halve bright picture ?
noehb:
	btst	#11,d0
	beq	noham
	move.l	#"HAM ",36(a0)	;one hold and modify picture ?
noham:
	moveq	#0,d0
	move.w	width,d0
	adda.l	#7,a0
	bsr	getascii	;get width of picture
	moveq	#0,d0
	move.w	height,d0
	lea	tx3,a0
	adda.l	#21,a0		;get height of picture
	bsr	getascii
	lea	fields,a5	;table of rects
	moveq	#4,d7		;number of rects -1
	move.l	wdwrast,dorast
	bsr	dofields	;display some rects
	lea	texte,a5	;table of texts
	moveq	#2,d7		;number of texts -1
	bsr	dotexts		;print some texts
	lea	gdgquit,a0
	move.l	intuibase,a6
	move.l	wdwhandle,a1
	move.l	#0,a2		;remake the gadgets (... strings)
	jsr	RefreshGadgets(a6)
	rts

; variables, texts, names, flags, handles, pointers and so on ...

dosname:	dc.b	"dos.library",0
		even
intuiname:	dc.b	"intuition.library",0
		even
graphname:	dc.b	"graphics.library",0
		even
bitmap:		ds.l	11	;bitmap-struct
infomem:	dc.l	0
dosbase:	dc.l	0
intuibase:	dc.l	0	;library-handles
graphbase:	dc.l	0
wdwhandle:	dc.l	0	;windowhandle
wscrclosehl:	dc.l	0
iffscreen:	dc.l	0	;screenhandle
wdwrast:	dc.l	0	;windowrastport
dorast:		dc.l	0	;rastport for rect-routine
thistask:	dc.l	0	;pointer to task struct
startsp:	dc.l	0	;stackpointer when programm is started
startmsg:	dc.l	0	;wb-startup-message-handle
iffmem:		dc.l	0	;pointer to memory for sound 1
long:		dc.l	0	;length of the sound
memo1:		dc.l	0	;one longword to keep s.th. in
memo2:		dc.w	0	;one word to keep s.th. in
iffview:	dc.l	0	;pointer to viewport-struct
planes:		ds.l	6	;pointers to up to 6 bitplanes
height:		dc.w	0	;height of picture
depth:		dc.w	0	;depth of picture
width:		dc.w	0	;width of picture
pwidth:		dc.w	0	;width of bitmap/display 
pheight:	dc.w	0	;height of bitmap/display
widthbytes:	dc.w	0	;width of display in bytes
fieldheight:	dc.w	0	;height of rect to draw
pltflag:	dc.b	0	;one byte to keep s.th. in
flags:		dc.b	0	;flags for packed/npacked & hires/nohires
time:		dc.b	0
		even

;table of dimensions of the rectangles that make the window-look

fields:	dc.w	2,10,337,52,2
	dc.w	13,15,167,10,0
	dc.w	186,15,40,10,2
	dc.w	233,15,51,10,2
	dc.w	290,15,40,10,2

;table of texts and their positions that make the window-look

texte:	dc.w	190,17
	dc.l	tx1
	dc.w	11,33
	dc.l	tx2
	dc.w	14,48
	dc.l	tx3

tx1:	dc.b	"LOAD  ABOUT  QUIT",0
	even
tx2:	dc.b	"Resolution:     *       Depth:   BPlanes",0
	even
tx3:	dc.b	"Width:       Height:       Special:     ",0
	even

;help-message

helptx:
 dc.b	"-----=== Platinum-Display-Replacement - PLTDisplay ===-----",0
 dc.b	" ",0
 dc.b	"© 1991 by Joerg Schliesser / Platinum Softwareline",0
 dc.b	"Rotenwaldstrasse 20 / D-7000 Stuttgart 1 / Germany",0
 dc.b	"PLTDisplay is freely distributable. (Only on disks,",0
 dc.b	"distributed in a non-commercial sense) Refer to PLTTools.doc.",0
 dc.b	"As long as this text remains unchanged",0
 dc.b	" ",0
 dc.b	"Click upper left corner of picture-screen to close screen",0
 dc.b	" ",0
 dc.b	"Click 'normal' position of depth-gadgets on picture-screen ",0
 dc.b	"to put screen to back/front",0
 dc.b	" ",0
 dc.b	"Use cursor-keys to scroll the display if width and/or",0
 dc.b	"height of picture are larger than resolution of the screen",0
 dc.b	" ",0
 dc.b	"To close this window press any key or mouse button",0
	even

textline:
	dc.b    1,0,1
	even
	dc.l	0,0,texttext,0
texttext:	ds.b	80

txtext:		dc.b	1,0,0
		even
		dc.l	0,0
txtextpoint:	dc.l	0,0

;window-structs

wplt:
	dc.w	20,15,342,64	;x,y,w,h
	dc.b	2,1		;colors
	dc.l	$440		;idcmp,rawkey,upgadget
	dc.l	$2011006	;activ,rmbtrap,front/back,drag
	dc.l	gdgquit,0,wplttitle,0,0
	dc.w	0,0,0,0
	dc.w	1
wplttitle:
	dc.b "PLTDisplay © '91 J.Schliesser",0
	even

screen:
	dc.w	0,0		;x,y
	dc.w	320,256		;width,height
	dc.w	0		;depth
	dc.b	0,0		;detail-pen/block-pen
	dc.w	0		;viewmodes
	dc.w	$4f		;type: custom,superbitmap
	dc.l	0		;font
	dc.l	0		;title
	dc.l	0		;gadgets
	dc.l	bitmap		;bitmap

wscrclose:
	dc.w	0,0,40,16	;x,y,w,h
	dc.b	0,0		;colors
	dc.l	$40000		;idcmp,activewindow
	dc.l	$10800		;rmbtrap,borderless
	dc.l	0,0,0
clscr:	dc.l	0,0,0,0
	dc.w	15

wabout:
	dc.w	49,5,540,190	;x,y,w,h
	dc.b	2,1		;colors
	dc.l	$408		;idcmp,rawkey,mousebuttons
	dc.l	$2011000	;activ,rmbtrap,wbenchwindow
	dc.l	0,0,0,0,0,0,0
	dc.w	1

; gadget structs

gdgquit:
	dc.l	gdghelp
	dc.w	290,15,41,11,0,1,1
	dc.l	0,0,0,0,0
	dc.w	1
	dc.l	0
gdghelp:
	dc.l	gdgload1
	dc.w	233,15,52,11,0,1,1
	dc.l	0,0,0,0,0
	dc.w	2
	dc.l	0
gdgload1:
	dc.l	filenamegdg
	dc.w	186,15,41,11,0,1,1
	dc.l	0,0,0,0,0
	dc.w	3
	dc.l	0
filenamegdg:
	dc.l	0
	dc.w	17,17,160,8,0,2,4
	dc.l	0,0,0,0,filenamegdginfo
	dc.w	4
	dc.l	0
filenamegdginfo:
	dc.l	filename,0
	dc.w	0,80,0,0,0,0,0,0
	dc.l	0,0,0
filename:
	ds.b	82

; display rendered fields (field-table => a5, number of fields => d7)

dofields:
	move.l	graphbase,a6
fielding:
	move.w	(a5)+,d4	;x-pos
	move.w	(a5)+,d5	;y-pos
	move.w	(a5)+,d6	;width of field
	move.w	(a5)+,fieldheight	;height of field
	move.l	dorast,a1	;get rastport
	moveq	#1,d0
	jsr	SetAPen(a6)	;set color for outline
	move.l	dorast,a1
	move.w	d4,d0
	move.w	d5,d1
	move.w	d4,d2
	move.w	d5,d3
	add.w	d6,d2
	add.w	fieldheight,d3
	jsr	RectFill(a6)	;draw outline of field
	move.l	dorast,a1
	move.w	(a5)+,d0
	jsr	SetAPen(a6)	;set color for field
	move.l	dorast,a1
	move.w	d4,d0
	move.w	d5,d1
	move.w	d4,d2
	move.w	d5,d3
	add.w	#2,d0
	add.w	#1,d1
	add.w	d6,d2
	add.w	fieldheight,d3
	sub.w	#2,d2
	sub.w	#1,d3		;draw field
	jsr	RectFill(a6)
	dbra	d7,fielding	;go on...
	rts			

; print some texts (table of texts => a5, number of texts => d7)

dotexts:
	move.l	intuibase,a6
texting:
	move.l	dorast,a0	;get rastport
	lea	txtext,a1
	move.w	(a5)+,d0	;get x-pos
	move.w	(a5)+,d1	;get y-pos
	move.l	(a5)+,txtextpoint	;pointer to ascii-text
	jsr	PrintIText(a6)	;print it ...
	dbra	d7,texting
	rts

;change window-pointer to sleeping

pltworkon:
	move.l	wdwhandle,a0
	move.l	intuibase,a6
	lea	sleeppoint,a1
	moveq	#16,d1
	moveq	#9,d0
	moveq	#0,d2
	moveq	#0,d3
	jsr	SetPointer(a6)
	rts

;change window-pointer to normal pointer

pltworkoff:
	move.l	wdwhandle,a0
	move.l	intuibase,a6
	jsr	ClearPointer(a6)
	rts

	section	pltdaten,data_c		;section 2, daten, chipmem

sleeppoint:
	dc.l	0
	dc.l	%00000000000000000001000100010000
	dc.l	%00010001000100000010101010101000
	dc.l	%00100010001000000101010101010000
	dc.l	%01000100010000001010101010100000
	dc.l	%11101110111000000001000100010000
	dc.l	%01000100010000001011101110100000
	dc.l	%01000100010000001010101010110101
	dc.l	%01000100010101011010101010101010
	dc.l	%00000000000000000100010001010101
	dc.l	0

 END