*************************************************************************
*	SCREEN COLOUR V.1.2 CODED BY BaTfInK OF QUARTZ IN 91		*
*	TO CONTACT ME CALL 0977-683578 (ALEX).				*
*************************************************************************

	include	df1:include/os.i

CUSTOMSCREEN=$f
getscreendata=-426
loadrgb4=-192
getrgb4=-582
firstscreen=60
activescreen=56

;Test:					;Simulate a dos entry as best as pos.
;	move.l	#name,a0
;	move.l	#so_name,d0
;	bsr	run
;	RTS

;Name:	dc.b	'asm 0 load'
;so_name=*-name
;	even

;------------------ OPEN RESOURCES --------------

;run:
	move.l	d0,OnIce1
	move.l	a0,OnIce2		;Pull Argv and Argc on ice

	move.l	Execbase,a6
	lea	Dosname(pc),a1
	moveq	#0,d0			
	jsr	Openlibrary(a6)		;Open DOS library
	move.l	d0,Dosbase
	bne	Opened_Doslib
	move.l	#20,Return		;Rtn. Fail		
	bra	No_DosLib
Opened_Doslib:
	move.l	Dosbase(pc),a6
	jsr	Output(a6)
	move.l	d0,Stndout		;Get handle of console
	bne	Got_Console
	move.l	#5,Return		;Rtn. Warn
	bra	No_Doslib		
Got_Console:
	move.l	Execbase,a6
	lea	Intname(pc),a1
	moveq	#0,d0
	jsr	Openlibrary(a6)		;Open intuition library
	move.l	d0,Intbase
	bne	Intlib_Ok
	lea	Error_No_Intlib(pc),a0
	bsr	Prtstr
	move.l	#20,Return		;Rtn. Fail
	bra	No_Intlib
Intlib_Ok:
	lea	Gfxname(pc),a1		;Open graphics library
	moveq	#0,d0
	jsr	Openlibrary(a6)	
	move.l	d0,Gfxbase
	bne	Gfxlib_OK
	lea	Error_No_Gfxlib(pc),a0
	bsr	Prtstr
	move.l	#20,Return		;Rtn. Fail
	bra	No_Gfxlib
Gfxlib_Ok:

;------------------ PROCESS ARGUMENTS -------------------

	move.l	OnIce1,d0
	move.l	OnIce2,a0		;Pull Argv and Argc off ice
	move.l	d0,d2			;D2 = DOSCMDLEN
	move.l	a0,a2			;A2 = DOSCMDBUF

	move.l	Execbase,a6		;Ask for memory for the arguments
	move.l	#(4*4)+256,d0	
	move.l	#public!clear,d1
	jsr	Allocmem(a6)		
	move.l	d0,Args_Memory
	bne	Args_Mem_Ok
	lea	Error_No_Mem(pc),a0
	bsr	Prtstr			
	move.l	#10,Return		;Rtn. Error
	bra	Exit_Prog

Args_Mem_Ok:
	move.l	d0,a3			;A3 = ARGV SLOTS
	move.l	a3,Argv_Slots
	move.l	d0,a1
	lea	4*4(a1),a1		;A1 = ARG BUFFER
	move.l	a1,Argv_Buffer
	
	lea	0(a2,d2.l),a0		;Null terminate arg, eat CTRL chars
stripjunk:				;yumm,yumm (burp!)
	cmp.b	#' ',-(a0)
	dbhi	d2,stripjunk
	clr.b	1(a0)			;Null terminate
	moveq	#0,d3

New_Arg:				;Start gathering args into buffer
	move.b	(a2)+,d1		
	beq	Parm_Exit
	cmp.b	#' ',d1			
	beq	New_Arg
	cmp.b	#9,d1			
	beq	New_Arg

	cmp.w	#4-1,d3
	beq	Parm_Exit

	move.l	a1,(a3)+		;Push adr of parm in argv slot
	addq.w	#1,d3			;Argument count +1
	cmp.b	#'"',d1			;Quotes?
	beq	Do_Quote
	move.b	d1,(a1)+		;Copy char in.
Next_Char:
	move.b	(a2)+,d1		;Null termination check
	beq	Parm_Exit
	cmp.b	#' ',d1
	beq	End_Arg
	move.b	d1,(a1)+
	bra	Next_Char
End_Arg:
	clr.b	(a1)+
	bra	New_Arg			;Next argument
Do_Quote:
	move.b	(a2)+,d1		;Process quotes
	beq	Parm_Exit
	cmp.b	#'"',d1
	beq	End_Arg
	cmp.b	#'*',d1			;* is a BCPL escape char
	bne	addquotechar
	move.b	(a2)+,d1
	move.b	d1,d2
	and.b	#$df,d2
	cmp.b	#'N',d2			;check for DOS newline
	bne	Check_Escape
	moveq	#10,d1			;got *n, turn into a newline
	bra	addquotechar
Check_Escape:
	cmp.b	#'E',d2			;Got *E
	bne	addquotechar
	moveq	#27,d1			;Turn into escape
Addquotechar:
	move.b	d1,(a1)+
	bra	Do_Quote
Parm_Exit:	
	clr.b	(a1)			;All done, null terminate args
	clr.l	(a3)	

;----------------- PRINT TITLE ------------------

	lea	Title(pc),a0
	bsr	Prtstr

;------------------ CHECK ARGUMENTS -------------

	cmp.w	#3,d3			
	beq	Args_Cnt_Valid
	lea	Error_Bad_Syntax(pc),a0
	bsr	Prtstr			;Print correct syntax
	move.l	#5,Return		;Rtn. Warn
	bra	Exit_Prog

Args_Cnt_Valid:
	move.l	Argv_Slots(pc),a2
	move.l	4(a2),a0		;Got ^ time out
	move.l	a0,a3			;save ^
	bsr	Strlen		
	move.l	a3,a0
	bsr	Getnum			;d0=num chars	
	move.l	d0,d1
	bmi	Skip_Timeout
	beq.s	Skip_Timeout		;Delay 0 Fucks Up OS


	move.l	Dosbase,a6
	mulu	#50,d1		
	jsr	Delay(a6)		;Wait for timeout
Skip_Timeout:

;------------------ PERFORM SCREEN COLOUR CHANGE ----------	

	move.l	Execbase,a6
	jsr	Forbid(a6)
	move.l	Intbase(pc),a3
	move.l	firstscreen(a3),a3	;Got first screen 
	jsr	Permit(a6)

	move.l	(a2),a0			
	bsr	Strlen			;sizeof name 
	move.l	d0,Sizeof_Screenname	;D0=Name Length
	move.l	a3,a0			;First screen
	move.l	(a2),a1			;Name 
	bsr	Findscreen		
	tst.l	d0			
	beq.s	Found_Screen		;Error if no screen was found
	lea	Error_Screen_Not_Found(pc),a0
	bsr	Prtstr
	move.l	#5,Return		;Rtn. Warn
	bra	Exit_Prog
	
Found_Screen:
	move.l	a0,a2			;Got screen!
	move.l	a2,Screen
	
	move.l	Execbase,a6		;Make sure it stays constant!
	jsr	Forbid(a6)
	lea	44(a2),a0
	move.l	a0,Viewport		;Got Viewport
	lea	44+40(a2),a0
	move.l	a0,Rastport		;Got Rastport
	move.l	Viewport,a2
	move.l	4(a2),Colourmap		;Got colourmap
	move.l	Rastport,a2
	move.l	4(a2),Bitmap		;Got bitmap
	move.l	Bitmap,a2
	moveq	#0,d0
	move.b	5(a2),d0
	move.l	d0,Planes		;Got planes
	jsr	Permit(a6)

	move.l	#64*2,d0
	move.l	#Clear!Public,d1
	jsr	Allocmem(a6)		;Get memory for colourtable
	move.l	d0,Colourtable
	bne	Got_Col_Mem
	lea	Error_No_Mem(pc),a0
	bsr	Prtstr
	move.l	#10,Return		;Rtn. Error
	bra	Exit_Prog

Got_Col_Mem:
	move.l	Argv_Slots(pc),a2
	lea	Arg2_Load(pc),a0
	bsr	StrLen			;d0=Chars
	move.l	8(a2),a0		;'Load' or 'Save'
	lea	Arg2_Load(pc),a1	;Actual Arg
	bsr	Cmpstr
	tst.l	d0			
	bne.s	Not_Load
	bsr	Load_Screen_Colours
	bra	Exit_Load_Save
Not_Load:
	lea	Arg2_Save(pc),a0
	bsr	StrLen			;d0=Chars
	move.l	8(a2),a0		
	lea	Arg2_Save(pc),a1
	bsr	Cmpstr
	tst.l	d0
	bne.s	Not_Save
	bsr	Save_Screen_colours
	bra	Exit_Load_Save
Not_Save:
	lea	Error_Bad_Syntax(pc),a0
	bsr	Prtstr
	move.l	#5,Return		;Rtn. Warn
	bra	Exit_Prog
	
;---------------- ALL DONE SO CLEANUP AND EXIT ------------------

Exit_Load_Save
	move.l	Execbase,a6
	move.l	#64*2,d0
	move.l	Colourtable(pc),a1
	jsr	Freemem(a6)		
Exit_prog:	
	move.l	Execbase,a6		;Free up memory
	move.l	#(4*4)+256,d0	
	move.l	Args_Memory(pc),a1
	jsr	Freemem(a6)		
Cli_Only:
	move.l	Gfxbase(pc),a1
	jsr	Closelibrary(a6)
No_Gfxlib:
	move.l	Intbase(pc),a1
	jsr	Closelibrary(a6)	;Close up libraries	
No_Intlib:
	move.l	Dosbase(pc),a1
	jsr	Closelibrary(a6)	
No_Doslib:
	move.l	Return(pc),d0		;Return code
	RTS				;* EXIT TO DOS *

;--------------------------------------------------------
;| 	PRINT STRING (A0=PTR TO NULL TERMINATED TXT)	|	
;--------------------------------------------------------

Prtstr:	
	movem.l	d2/d3/a6,-(sp)	
	moveq	#0,d3
.Prt1:
	tst.b	(a0,d3.l)		;Char=NULL ?
	beq.s	.Prt2			;Yes then eo txt
	addq.w	#1,d3		
	bra.s	.Prt1				
.Prt2:
	move.l	Dosbase(pc),a6
	move.l	Stndout,d1		
	move.l	a0,d2			;d2=ptr to txt d3=number of chars
	jsr	Write(a6)		;print message ;;
	movem.l	(sp)+,d2/d3/a6
        RTS

;----------------------------------------------------------------
;|	GET NUMBER (A0=PTR TO STRING D0=NUMBER OF DIGITS)	|
;|	RETURN WITH D0=NUMERICAL VALUE //			|
;----------------------------------------------------------------

GETNUM:
	movem.l	d3/d7,-(sp)
	moveq	#0,d3		;Clr Error Flag
	tst.l	d0		
	bne.s	.Convert
	moveq	#-1,d0		;Error
	bra.s	.Exit_GetNum
.Convert:
	move.w	d0,d7
	subq.w	#1,d7		;Got Loop
	moveq	#0,d0
.GetDec_Loop:
	moveq	#0,d1
	move.b	(a0)+,d1	
	sub.b	#'0',d1		;Ascii => Numeric
	cmp.b	#10,d1		
	bcs	.Valid_Char
	moveq	#-1,d3		;Set Error
.Valid_Char:
	mulu	#10,d0
	add.w	d1,d0
	dbra	d7,.GetDec_Loop
	tst.l	d3		
	beq.s	.Exit_Getnum	;Error Flag Set?
	move.l	d3,d0		;Pass Return In D0
.Exit_GetNum:
	movem.l	(sp)+,d3/d7
	RTS	

;------------------------------------------------------------------------
;|	COMPARE STRING (STRING1,STRING2,CHARS) (A0,A1,D0)		|
;|	RETURNS D0=0 IF OK ELSE D0=-1					|
;|	CASE DOESNT MATTER E.G A=a AND Z=z //				|
;------------------------------------------------------------------------

Cmpstr:
	movem.l	d2/d3/d7,-(sp)
	moveq	#0,d3			;Clr Error Flag
	tst.l	d0			;Any Chars?
	bne.s	.SomeChars
	moveq	#-1,d3			;Set Error
	bra.s	.Exit_CmpStr
.SomeChars:
	move.w	d0,d7
	subq.w	#1,d7			;Got Loop
.Cmpstr_Loop:
	moveq	#0,d0
	move.b	(a0)+,d0		;Get String1 Char
	bsr	Lowcase_Char		;-> Lwr Case
	move.b	d0,d2
	moveq	#0,d0
	move.b	(a1)+,d0		;Get String2 Char
	bsr	Lowcase_Char		;-> Lwr Case
	cmp.b	d0,d2			;Equal?
	beq.s	.Char_Match
	moveq	#-1,d3			;Set Error Flag
.Char_Match:
	dbra	d7,.Cmpstr_Loop
.Exit_CmpStr:
	move.l	d3,d0			;Pass Return In d0
	movem.l	(sp)+,d2/d3/d7
	RTS

;----------------------------------------------------------------
;|		LOWCASE (C STRING) (A0)				|
;|		CONVERT STRING CHARS ALL TO LOWER CASE.	 	|
;----------------------------------------------------------------

Lowcase:
	move.b	(a0)+,d0		;Get char
	beq.s	.Converted
	cmp.b	#'A',d0
	bcs.s	Lowcase
	cmp.b	#'Z',d0
	bhi.s	Lowcase
	add.b	#'a'-'A',d0
	move.b	d0,-1(a0)		;Put char back
	bra.s	Lowcase			
.Converted:
	RTS				

;--------------------------------------------------------
;|		LOWCASE CHAR (CHAR) (D0)		|
;|		CHAR RETURNED IN D0			|
;--------------------------------------------------------

Lowcase_char:				
	cmp.b	#'A',d0			
	bcs.s	.Is_Low
	cmp.b	#'Z',d0
	bhi.s	.Is_Low
	add.b	#'a'-'A',d0
.Is_Low:RTS

;--------------------------------------------------------
;|		SIZEOF STRING (C STRING) (A0)		|		
;|		RETURNS STRING LENGTH IN D0		|
;--------------------------------------------------------

Strlen:
	moveq	#0,d0
.Strlen_Loop:
	move.b	(a0)+,d1
	beq.s	.Got_Length
	addq	#1,d0
	bra	.Strlen_Loop
.Got_Length:RTS		

;------------------------------------------------------------------------
;|	FINDSCREEN (NAME LENGTH,^ FIRST SCREEN,TITLE) (D0/A0/A1)	|
;|		D0=NULL IF SCREEN FOUND ELSE D0=-1			|
;|		A0=^ SCREEN						|
;------------------------------------------------------------------------

Findscreen:
	move.l	a2,-(sp)
	move.l	a0,a2			;A2 = ^ 1st screen 
.Find_Loop:
	move.l	26(a2),a0		;Got ^ default title
	movem.l	d0/a1,-(sp)		;Save ^ name, num chars
	bsr	Cmpstr	
	tst.l	d0			;Chk return code
	movem.l	(sp)+,d0/a1		
	bne.s	.Continue_Screensearch	
	moveq	#0,d0			
	bra.s	.Done_Screensearch
.Continue_Screensearch:
	move.l	(a2),a2			;Nxt Screen
	cmp.l	#0,a2			;E.o Screens?
	bne.s	.Find_Loop
	moveq	#-1,d0			;Set Error Flag
.Done_Screensearch:
	move.l	a2,a0			;Return Screen ^ in A0
	move.l	(sp)+,a2
	RTS

;------------------------------------------------
;|		LOAD SCREEN COLOURS		|
;------------------------------------------------

Load_Screen_Colours:
	move.l	Execbase,a6
	move.l	#256,d0
	move.l	#Public!clear,d1
	jsr	Allocmem(a6)		;Get mem for args
	move.l	d0,a2
	bne	Got_Load_Mem
	lea	Error_No_Mem(pc),a0
	bsr	Prtstr
	move.l	#10,Return		;Rtn. Error
	bra	Save_Mem_Error		
Got_Load_Mem:				;A2 = Memory
	move.l	a2,a1
	lea	Path_Name(pc),a0
	move.w	(a0),(a1)+		;Copy path name across
	move.l	Argv_Slots(pc),a0	
	move.l	(a0),a0
	move.l	Sizeof_Screenname,d0
	jsr	Copymem(a6)		;Copy screen name across	
	lea	Suffix(pc),a0
	move.l	a2,a1
	add.l	Sizeof_Screenname(pc),a1;Skip name
	addq	#So_Path,a1		;Skip path
	moveq	#So_Suffix,d0
	jsr	Copymem(a6)		;Copy suffix across

	move.l	Dosbase(pc),a6
	move.l	a2,d1			;get ^ name
	move.l	#1005,d2		;Mode_Read
	jsr	Open(a6)		;Open saved colours file
	tst.l	d0
	bne	Load_Open_OK
	lea	Error_Open(pc),a0
	bsr	Prtstr
	move.l	#10,Return		;Rtn. Error
	bra	Load_Error
Load_Open_Ok:
	move.l	d0,d6			;Got handle in d6
	move.l	d6,d1
	move.l	Colourtable(pc),d2
	move.l	Planes(pc),d0
	moveq	#1,d3			
	lsl.l	d0,d3			;Got size of file (words)
	add.l	d3,d3			;(bytes)
	jsr	Read(a6)
	move.l	d0,d5			

	move.l	d6,d1
	jsr	Close(a6)		;Close access
	tst.l	d5			;Test read result
	bpl	Load_Write_Ok
	lea	Error_Write(pc),a0
	bsr	Prtstr
	move.l	#10,Return		;Rtn. Error
	bra	Load_Error
Load_Write_Ok:
	move.l	Gfxbase(pc),a6
	move.l	Viewport(pc),a0
	move.l	Colourtable(pc),a1		;^ Colours	
	move.l	Planes(pc),d1		;Count
	moveq	#1,d0
	lsl.l	d1,d0
	jsr	LoadRGB4(a6)		;Set new colours
Load_Error:
	move.l	Execbase,a6
	move.l	#256,d0
	move.l	a2,a1
	jsr	Freemem(a6)		;Get mem for args
Load_Mem_Error:
	RTS

;------------------------------------------------
;|		SAVE SCREEN COLOURS		|
;------------------------------------------------

Save_Screen_Colours:
	move.l	Execbase,a6
	move.l	#256,d0
	move.l	#Public!clear,d1
	jsr	Allocmem(a6)		;Get mem for args
	move.l	d0,a2		
	bne	Got_Save_Mem
	lea	Error_No_Mem(pc),a0
	bsr	Prtstr
	move.l	#10,Return		;Rtn. Error
	bra	Save_Mem_Error
Got_Save_Mem:				;A2 = Memory
	move.l	Gfxbase(pc),a6
	move.l	Planes(pc),d6			
	moveq	#1,d7
	lsl.w	d6,d7			
	subq	#1,d7			;Got loop			

	moveq	#0,d2			
	move.l	Colourmap(pc),a3
	move.l	Colourtable(pc),a4		
Get_Colours_Loop:
	move.l	d2,d0			;Got entry	
	move.l	a3,a0			;Got colourmap
	jsr	GetRGB4(a6)		
	move.w	d0,(a4)+		;Save colour
	addq	#1,d2			;Nxt entry
	dbra	d7,Get_Colours_Loop

	move.l	Execbase,a6
	move.l	a2,a1
	lea	Path_Name(pc),a0
	move.w	(a0),(a1)+		;Copy path name across
	move.l	Argv_Slots(pc),a0	
	move.l	(a0),a0
	move.l	Sizeof_Screenname(pc),d0
	jsr	Copymem(a6)		;Copy screen name across	

	lea	Suffix(pc),a0
	move.l	a2,a1
	add.l	Sizeof_Screenname(pc),a1;Skip name
	addq	#So_Path,a1		;Skip suffix
	moveq	#So_Suffix,d0
	jsr	Copymem(a6)		;Copy suffix across
	
	move.l	Dosbase(pc),a6
	move.l	a2,d1			;get ^ name
	move.l	#1006,d2		;mode_write
	jsr	Open(a6)		;Open saved colours file
	move.l	d0,d6			;D6 = HANDLE
	bne	Save_Open_Ok
	lea	Error_Open(pc),a0
	bsr	Prtstr
	move.l	#10,Return		;Return Error
	bra	Save_Error
Save_Open_Ok:
	move.l	d6,d1
	move.l	Colourtable(pc),d2
	move.l	Planes(pc),d0
	moveq	#1,d3
	lsl.l	d0,d3			;Size of file in words
	lsl.l	#1,d3			;bytes
	jsr	Write(a6)		;Save colours
	move.l	d0,d5			;D6 = WRITE RETURN		

	move.l	d6,d1
	jsr	Close(a6)		;Close access
	tst.l	d5			;Test read result
	bpl	Save_Error		;Not an error!
	lea	Error_Write(pc),a0
	move.l	#10,Return		;Return Error
	bsr	Prtstr			
Save_Error:
	move.l	Execbase,a6
	move.l	#256,d0
	move.l	a2,a1
	jsr	Freemem(a6)		;Get mem for args
Save_Mem_Error
	RTS

;-------- VARIABLES ---------

Dosbase:		dc.l	0
Gfxbase:		dc.l	0
Intbase:		dc.l	0
Stndout:		dc.l	0
Args_Memory:		dc.l	0
ArgV_slots:		dc.l	0
ArgV_buffer:		dc.l	0
Sizeof_Screenname:	dc.l	0
Screen:			dc.l	0
Viewport:		dc.l	0
Rastport:		dc.l	0
Colourmap:		dc.l	0
Planes:			dc.l	0
Bitmap:			dc.l	0
Colourtable:		dc.l	0
OnIce1:			dc.l	0
OnIce2:			dc.l	0
Return:			dc.l	0
		
Path_Name:	dc.b	'S:'		;This bit *MUST* be word aligned
So_Path=*-Path_Name
Suffix:		dc.b	'.Col',0
So_Suffix=*-Suffix

Intname:	dc.b	'intuition.library',0
Dosname:	dc.b	'dos.library',0
Gfxname:	dc.b	'graphics.library',0
Arg2_Load:	dc.b	'load',0
Arg2_Save:	dc.b	'save',0
Error_No_Doslib:dc.b	'Unable to open Dos library.',Cr,0
Error_No_Intlib:dc.b	'Unable to open Intuition library.',Cr,0
Error_No_Gfxlib:dc.b	'Unable to open Graphics library.',Cr,0
Error_No_Mem:	dc.b	'Unable to allocate sufficient memory.',Cr,0
Error_Open:	dc.b	'Unable to open file.',Cr,0
Error_Read:	dc.b	'Unable to read file.',Cr,0
Error_Write:	dc.b	'Unable to write file.',Cr,0
Error_Screen_Not_Found:
		dc.b	'Unable to locate screen',Cr,0
Error_Bad_Syntax:dc.b	$9b,'1;31;40',$6d,'Syntax:'
		dc.b	$9b,'0;31;40',$6d,' Screencolour <screen name> '
		dc.b	'<timeout> <load|save>',Cr,Cr
 dc.b 'Brief Instructions: (Please read screencolour.doc):',Cr
 dc.b 'i)   Load up your favourite screen (Mines MCAsm).',Cr
 dc.b 'ii)  Load up a palette tool and alter the screen colours to your choice.',Cr
 dc.b "iii) Type 'Screencolour <screen name> 0 save' and your palette",Cr
 dc.b '     will be saved to disk.',Cr
 dc.b "iv)  Enter 'Screencolour <screen name> 5 load' in your startup",Cr
 dc.b '     sequence straight after the line which loads your program.',Cr
 dc.b 'vi)  This wonderful program will then restore the desired colours',Cr
 dc.b '     to your screen every time you reboot without messing around',Cr
 dc.b '     with the palette tool.',Cr,0

Title:		dc.b	Cr,$9b,'0;31;43',$6d
		dc.b	'Screen Colour V1.1b:'
		dc.b	$9b,'0;31;40',$6d,' Coded By '
		dc.b	$9b,'1;31;40',$6d,'->> BaTfInK <<-'
		dc.b	$9b,'0;31;40',$6d,' Of '
		dc.b	$9b,'3;31;40',$6d,'Quartz.'
		dc.b	$9b,'0;31;40',$6d,Cr
		dc.b	'61 Elmete Ave,Sherburn-In-Elmet,Nr Leeds,LS25-6EH,',Cr
		dc.b	'ENGLAND. Tel. +44 0977 683578',Cr,Cr,0

 dc.b	'Hi Binary File Editor Freak!'
 dc.b	'Get A Life And Stop Fucking Around With My Program!.'