*************************************
*************************************
**                                 **
**          TSTSORTER v2.0         **
**      Written By BEYAZ of TST    **
**                                 **
**   TST Adres: Sumer mah. 28 sok. **
**              Zeytinburnu / ist  **
**              TURKIYE            **
**                                 **
**   TST Tel: 558 12 54 / istanbul **
**                                 **
** Programmed on KEFRENS SEKA v3.2 **  
*************************************
*************************************

ExecBase:	EQU	4
OpenLib:	EQU	-408
CloseLib:	EQU	-414
OpenWindow:	EQU	-204
CloseWindow:	EQU	-72
AllocMemory:	EQU	-198	
FreeMemory:	EQU	-210
OpenScreen:	EQU	-198
CloseScreen:	EQU	-66
Move:           EQU	-240
Text:           EQU	-60
SetApen:	EQU	-342
SetBPen:	EQU	-348
Draw:           EQU	-246
ModeOld:	EQU	1005
ModeNew:	EQU	1006
Open:           EQU	-30
Close:          EQU	-36
Read:           EQU	-42
Write:          EQU	-48
Lock:           EQU	-84
UnLock:         EQU	-90
Examine:	EQU	-102
ExNext:         EQU	-108
OIError:        EQU	-132
KeyBuffer:	EQU	$bfec01

START:
	movem.l	d0-d7/a0-a6,-(SP)	; save registers
	bsr	OpenLibs
	bsr	OpenScr
	bsr	OpenWind
	bsr	WriteScreen
	move.b	#0,Flag
	bsr	WriteAbout
	bsr	GetMaxDataCount
	bsr	WriteNumbers
	bsr	AllocMem
	move.b	#1,Flag

	bsr	main	; MAIN PROGRAM LOOP

	bsr	FreeMem
	bsr	CloseWind
	bsr	CloseScr
	bsr	CloseLibs
	movem.l	(SP)+,d0-d7/a0-a6
	rts				; E X I T

****************************************
* Open Libraries & Write Library Bases *
****************************************
OpenLibs:
	move.l	ExecBase,a6	; use exec.library

	lea	IntName,a1	; get library name
	clr.l	d0		; version
	jsr	OpenLib(a6)	; open intuition.library
	move.l	d0,IntBase	; store intuition pointer

	lea	DosName,a1	; get library name
	clr.l	d0		; version
	jsr	OpenLib(a6)	; open dos.library
	move.l	d0,DosBase	; store dos pointer

	lea	GfxName,a1	; get library name
	clr.l	d0		; version
	jsr	OpenLib(a6)	; open graphics.library
	move.l	d0,GfxBase	; store graphics pointer

	rts			; return

DosName:	dc.b	'dos.library',0
IntName:	dc.b	'intuition.library',0
GfxName:	dc.b	'graphics.library',0
even
DosBase:	dc.l	0
IntBase:	dc.l	0
GfxBase:	dc.l	0

*******************
* Close Libraries *
*******************
CloseLibs:
	move.l	ExecBase,a6	; use exec.library

	move.l	IntBase,a1	; get intuition pointer
	jsr	CloseLib(a6)	; close intuition.library

	move.l	DosBase,a1	; get dos pointer
	jsr	CloseLib(a6)	; close dos.library

	move.l	GfxBase,a1	; get graphics pointer
	jsr	CloseLib(a6)	; close graphics.library

	rts			; return

************************************
* Open Screen & Initilixe Rastport *
************************************
OpenScr:
	move.l	IntBase,a6
	lea	NewScreen,a0
	jsr	OpenScreen(a6)
	move.l	d0,ScreenPtr

	move.l	ScreenPtr,a0
	add.l	#$54,a0		;Find Rastport
	move.l	a0,Rastport
	rts
Rastport:	dc.l	0
NewScreen:
	dc.w	0		; X origin
	dc.w	0		; Y origin
	dc.w	640		; Width
	dc.w	256		; Height
	dc.w	1		; Depth
	dc.b	0		; Detail Pen
	dc.b	1		; Block Pen
	dc.w	$8000		; Display Modes
	dc.w	1		; Screen Type
	dc.l	0		; Pointer to Def. Font
	dc.l	ScreenTitle	; Screen Name
	dc.l	0		; List of Gadgets
	dc.l	0		; Bitmap Struct
ScreenTitle:	dc.b	'TST Sorter v2.0 Written By Hasan Beydagi',0
even
****************
* Close Screen *
****************
CloseScr:
	move.l	IntBase,a6
	move.l	ScreenPtr,a0
	jsr	CloseScreen(a6)
	rts

***************
* Open Window *
***************
OpenWind:
	move.l	IntBase,a6
	lea	NewWindow,a0
	jsr	OpenWindow(a6)
	move.l	d0,WindowPtr
	rts

WindowPtr:	dc.l	0
NewWindow:
		dc.w	0		;Left Edge
		dc.w	0		;Top Edge
		dc.w	640		;Width
		dc.w	256		;Height
		dc.b	1		;Detail Pen
		dc.b	0		;Block Pen
		dc.l	0		;IDCMP Flags
		dc.l	$1000		;Flags
		dc.l	0		;First Gadget
		dc.l	0		;CheckMark
		dc.l	WindowTitle	;Window Title
ScreenPtr:	dc.l	0		;Pointer to Screen
		dc.l	0		;Bitmap		
		dc.w	640		;Min Width
		dc.w	256		;Min Height
		dc.w	640		;Max Width
		dc.w	256		;Max Height
		dc.w	15		;Custom Screen
WindowTitle:	dc.b	'TST Sorter v2.0  Written By Hasan Beydagi'
		dc.b	'                        (Press HELP)',0

****************
* Close Window *
****************
CloseWind:
	move.l	IntBase,a6
	move.l	WindowPtr,a0
	jsr	CloseWindow(a6)
	rts

*********************
* Main program loop *
*********************
Main:
	move.b	KeyBuffer,d0
	not.b	d0
	lsr.b	#1,d0

	cmp.b	#$45,d0		; 'ESC'
	beq	Exit

	cmp.b	#$5f,d0		; 'HELP'
	beq	WriteHelp

	cmp.b	#$50,d0		; 'F1'
	beq	NewData

	cmp.b	#$51,d0		; 'F2'
	beq	LoadData

	cmp.b	#$52,d0		; 'F3'
	beq	SaveData

	cmp.b	#$53,d0		; 'F4'
	beq	AddData

	cmp.b	#$54,d0		; 'F5'
	beq	FindData

	cmp.b	#$55,d0		; 'F6'
	beq	EditData

	cmp.b	#$56,d0		; 'F7'
	beq	DeleteData

	cmp.b	#$57,d0		; 'F8'
	beq	SortData

	cmp.b	#$58,d0		; 'F9'
	beq	PrintListe

	cmp.b	#$59,d0		; 'F10'
	beq	ChangeTitle

	cmp.b	#$37,d0		; 'M'
	beq	MergeData

	cmp.b	#$22,d0		; 'D'
	beq	ShowDir

	cmp.b	#$4d,d0		; 'CURSOR DOWN'
	beq	OneBackward

	cmp.b	#$4c,d0		; 'CURSOR UP'
	beq	OneForward

	cmp.b	#$4e,d0		; 'CURSOR RIGHT'
	beq	OnePageForw

	cmp.b	#$4f,d0		; 'CURSOR LEFT'
	beq	OnePageBack

	cmp.b	#$63,d0		; 'CTRL'
	beq	WriteAbout

	bra	Main

*************************
* Go Back From MainLoop *		
*************************
Exit:
	rts
************************************************
* Open About Window & Write About This Program *
************************************************

WriteAbout:
	lea	AboutText,a1
	clr.l	d0
	clr.l	d1
checksum:
	move.b	(a1)+,d1
	add.l	d1,d0
	cmp.b	#0,(a1)
	bne	checksum
	cmp.l	#$678b,d0
	bne	notok

	bsr	OpenAboutWindow
	move.l	#AboutText,d2
	bsr	WriteAboutText
APressAnyKey:
	move.b	KeyBuffer,d0
	not.b	d0
	lsr.b	#1,d0

	cmp.b	#$40,d0
	bne	APressAnyKey

	clr.b	KeyBuffer
	bsr	CloseAboutWindow

	cmp.b	#1,Flag		;If Flag = 1 Then
	beq	Main		;Go to Main Loop
	rts

Flag:	dc.b	0

even
OpenAboutWindow:
	move.l	DosBase,a6
	move.l	#AboutWindowData,d1
	move.l	#1006,d2	;Mode Old File
	jsr	Open(a6)	;Open Window
	move.l	d0,AboutWindow
	rts

WriteAboutText:
	move.l	DosBase,a6
	move.l	d2,a0
	moveq	#0,d3
ALength:
	add.l	#1,d3
	cmp.b	#0,(a0)+
	bne	ALength
	sub.l	#1,d3
	move.l	AboutWindow,d1
	jsr	Write(a6)
	rts

CloseAboutWindow:
	move.l	DosBase,a6
	move.l	AboutWindow,d1
	jsr	Close(a6)	; CloseWindow
	rts

Notok:
	jmp	$fc0000
AboutWindow:	dc.l	0
AboutWindowData:dc.b	'CON:140/30/350/200/TST Sorter About Window  ',0

AboutText:
	dc.b	$0d,$0a,$0d,$0a
	dc.b	$09,'TTTTT SSSSS TTTTT ',$0d,$0a
	dc.b	$09,'  T   S       T ',$0d,$0a
	dc.b	$09,'  T   SSSSS   T ',$0d,$0a
	dc.b	$09,'  T       S   T ',$0d,$0a
	dc.b	$09,'  T   SSSSS   T Sorter v2.0 ',$0d,$0a,$0d,$0a
	dc.b	'   Written By Hasan Beydagi',$0d,$0a,$0d,$0a
	dc.b	'   Tel: (1) 558 12 54  Turkiye',$0d,$0a,$0d,$0a
	dc.b	'   Adress: Sumer Mah.28 Sok. No:14',$0d,$0a
	dc.b	'           34770 Zeytinburnu  ISTANBUL',$0d,$0a
	dc.b	'                               TURKEY',$0d,$0a,$0d,$0a
	dc.b	'   If you send me SEKA SOURCES',$0d,$0a
	dc.b	"   I'll send you DIFFERENT SOURCES (%100)",$0d,$0a
	dc.b	$0d,$0a,'     Spread by ZOMBIE BOYS from TURKEY'
	dc.b	$0d,$0a,$0d,$0a
	dc.b	$09,'   PRESS SPACE TO CONTINUE      ',0
even
*********************************
* Write Help Key Menu To Window *
*********************************
WriteHelp:
	bsr	OpenHelpWindow
	move.l	#HelpText,d2
	bsr	WriteHelpText
PressAnyKey:
	move.b	KeyBuffer,d0
	not.b	d0
	lsr.b	#1,d0

	cmp.b	#$40,d0
	bne	PressAnyKey

	clr.b	KeyBuffer
	bsr	CloseHelpWindow
	bra	Main

OpenHelpWindow:
	move.l	DosBase,a6
	move.l	#HelpWindowData,d1
	move.l	#1006,d2	;Mode Old File
	jsr	Open(a6)	;Open Window
	move.l	d0,HelpWindow
	rts

WriteHelpText:
	move.l	DosBase,a6
	move.l	d2,a0
	moveq	#0,d3
Length:
	add.l	#1,d3
	cmp.b	#0,(a0)+
	bne	Length
	sub.l	#1,d3
	move.l	HelpWindow,d1
	jsr	Write(a6)
	rts

CloseHelpWindow:
	move.l	DosBase,a6
	move.l	HelpWindow,d1
	jsr	Close(a6)	; CloseWindow
	rts

HelpWindow:	dc.l	0
HelpWindowData:	dc.b	'CON:110/22/400/216/TST Sorter Help Window  ',0
*****************************
*   $0d = Carriage Return   *
*   $0a = Line Feed         *
*   $09 = Tab               *
*****************************

HelpText:
	dc.b	$0d,$0a,$0d,$0a
	dc.b	$09,'F1.............New Liste',$0d,$0a
	dc.b	$09,'F2.............Load New Liste',$0d,$0a
	dc.b	$09,'F3.............Save Liste',$0d,$0a
	dc.b	$09,'F4.............Add Data',$0d,$0a
	dc.b	$09,'F5.............Search Data',$0d,$0a
	dc.b	$09,'F6.............Edit Data',$0d,$0a
	dc.b	$09,'F7.............Delete Data',$0a,$0d
	dc.b	$09,'F8.............Sort Liste',$0d,$0a
	dc.b	$09,'F9.............Print Liste',$0d,$0a
	dc.b	$09,'F10............Change Title',$0d,$0a
	dc.b	$09,'M..............Merge Liste',$0d,$0a
	dc.b	$09,'D..............Show Directory ',$0d,$0a
	dc.b	$09,'CURSOR UP......One Data Forward',$0d,$0a
	dc.b	$09,'CURSOR DOWN....One Data Backward',$0d,$0a
	dc.b	$09,'CURSOR RIGHT...One Page Forward',$0d,$0a
	dc.b	$09,'CURSOR LEFT....One Page Backward',$0d,$0a
	dc.b	$09,'CTRL...........About',$0d,$0a
	dc.b	$09,'HELP...........This Help Menu',$0d,$0a
	dc.b	$09,'ESC............Quit Program ',$0d,$0a,$0a,$0d,$0d,$0a
	dc.b	$09,'   PRESS SPACE TO CONTINUE      ',$0
even
***********************************
*    Clear Screen & Write Design  *
***********************************
WriteScreen:
	move.l	#20,TextX
	move.l	#20,TextY
	bsr	MoveCursor

	move.l	#DataText,TextAdres
	move.l	#62,TextCount
	bsr	WriteText

	move.l	#20,TextX
	move.l	#30,TextY
	bsr	MoveCursor

	move.l	#Statu,TextAdres
	move.l	#7,TextCount
	bsr	WriteText

	move.l	#20,TextX
	move.l	#40,TextY
	bsr	MoveCursor

	move.l	#Title,TextAdres
	move.l	#52,TextCount
	bsr	WriteText

	move.l	#00,TextX
	move.l	#50,TextY
	bsr	MoveCursor

	move.l	#Header,TextAdres
	move.l	#61,TextCount
	bsr	WriteText
	
	move.l	#15-1,d5		;Line Counter
	lea	MDataX,a2
	lea	MDataY,a3
	lea	DDataX,a4
	lea	DDataY,a5
DrawLoop:
	move.l	(a2)+,TextX
	move.l	(a3)+,TextY
	bsr	MoveCursor

	move.l	(a4)+,DrawX
	move.l	(a5)+,DrawY
	bsr	LineDraw

	dbf	d5,DrawLoop
	rts

MoveCursor:
	move.l	GfxBase,a6
	move.l	Rastport,a1
	move.l	TextX,d0	; X Coord.
	move.l	TextY,d1	; Y Coord.
	jsr	Move(a6)	; Move Cursor
	rts
WriteText:
	move.l	GfxBase,a6
	move.l	Rastport,a1
	move.l	TextAdres,a0	; Text
	move.l	TextCount,d0	; Count
	jsr	Text(a6)	; Write  Text
	rts
LineDraw:
	move.l	GfxBase,a6
	move.l	Rastport,a1
	move.l	DrawX,d0
	move.l	DrawY,d1
	jsr	Draw(a6)
	rts

TextX:		dc.l	0
TextY:		dc.l	0
TextAdres:	dc.l	0
TextCount:	dc.l	0
DrawX:		dc.l	0
DrawY:		dc.l	0
MDataX:		dc.l	000,000,155,156,203,204,259,260,331,332,371,372
		dc.l	427,428,000
MDataY:		dc.l	042,052,042,042,042,042,042,042,042,042,042,042
		dc.l	042,042,247
DDataX:		dc.l	639,639,155,156,203,204,259,260,331,332,371,372
		dc.l	427,428,639
DDataY:		dc.l	042,052,247,247,247,247,247,247,247,247,247,247
		dc.l	247,247,247


DataText:	dc.b	'ActiveData:        FullData:       '
		dc.b    'FreeData:        TotalData:'
Statu:		dc.b	'STATUS: OK.'
Title:		dc.b	'TITLE:   TST Sorter v2.0 TST Tel:(1)558 12 54 '
		dc.b	'TURKEY'
Header:		dc.b	'NAME                ID    LENGHT DATE     KICK'
		dc.b	' MEMORY EXPLAIN'   

**************************************************************
*  Get Maximum Data Counter From Keyboard & Alloccate Memory *
**************************************************************

GetMaxDataCount:
	bsr	OpenInputWindow

	move.l	#DataQuestion,d2	;Read
	bsr	WriteWindow		;Maximum DataNumber
	bsr	ReadWindow		;From Keyboard
	bsr	CloseInputWindow

	move.l	#3,d0
	lea	Input,a0
	lea	TotalASCII,a1
DigitControl:
	move.b	(a0)+,d1

	cmp.b	#$2f,d1
	bls	GreatNumber
	cmp.b	#$3a,d1
	bge	GreatNumber

	move.b	d1,(a1)+
	dbf	d0,DigitControl

	cmp.b	#$0a,(a0)+	;RETURN
	bne	GreatNumber

	move.l	TotalASCII,FreeASCII
	move.l	#'0000',ActiveASCII
	move.l	#'0000',FullASCII
	move.l	#0,ActiveHex
	move.l	#0,FullHex

	clr.l	d0
	clr.l	d1
	move.l	#TotalASCII,d2
	move.l	#4,d3
	bsr	ASCIIDecToHex
	move.l	d0,TotalHex
	move.l	d0,FreeHex

	rts
GreatNumber:
	move.l	#NumberError,TextAdres
	bsr	Status	
	bra	GetMaxDataCount	

Status:
	move.l	#84,TextX
	move.l	#30,TextY
	bsr	MoveCursor

	move.l	#54,TextCount
	bsr	WriteText

	rts

NumberError:	dc.b	'WRONG NUMBER!!..PLEASE ENTER AGAIN      '
		dc.b	'              '

ActiveASCII:	dc.b	'0000'
FullASCII:	dc.b	'0000'
FreeASCII:	dc.b	'0000'
TotalASCII:	dc.b	'0000'
ActiveHex:	dc.l	0
FullHex:	dc.l	0
FreeHex:	dc.l	0
TotalHex:	dc.l	0

DataQuestion:	dc.b	$0d,$0a,$0d,$0a,$09,'Enter Maximum Data Count'
		dc.b	' (Max 9999): ',0

even
*****************************
*  Write Numbers To Screen  *
*****************************
WriteNumbers:
	move.l	#108,TextX
	move.l	#20,TextY
	bsr	MoveCursor

	move.l	#ActiveASCII,TextAdres
	move.l	#4,TextCount
	bsr	WriteText

	move.l	#244,TextX
	move.l	#20,TextY
	bsr	MoveCursor

	move.l	#FullASCII,TextAdres
	move.l	#4,TextCount
	bsr	WriteText

	move.l	#372,TextX
	move.l	#20,TextY
	bsr	MoveCursor

	move.l	#FreeASCII,TextAdres
	move.l	#4,TextCount
	bsr	WriteText

	move.l	#516,TextX
	move.l	#20,TextY
	bsr	MoveCursor

	move.l	#TotalASCII,TextAdres
	move.l	#4,TextCount
	bsr	WriteText

	rts
******************************************************************
*  Converts A Decimal ASCII String Into A Hexadecimal Long word  *
*                                                                *
*  ENTRY        D0 = Zero                                        *
*               D1 = Zero                                        *
*               D2 = Buffer Address                              *
*               D3 = Buffer Length                               *
*  EXIT         D0 = Hex Number                                  *
*               D1 = 0 = Syntax Error  1 = Success               *
*               D2 = Unchanged                                   *
*               D3 = Unchanged                                   *
******************************************************************
ASCIIDecToHex:
	tst.l	D1			;previous success?
	bne	Hex7			;yes, go exit
	movem.l	D2-D4/A0,-(A7)		;save registers
	move.l	D2,A0			;get ASC buffer address
	add.l	D3,A0			;point to end of buffer
	move.l	#1,D2			;get 1st digit
	bsr	Hex3			;go convert it
	move.l	#10,D2			;get 2nd digit
	bsr	Hex3			;go convert it
	move.l	#100,D2			;get 3rd digit
	bsr	Hex3			;go convert it
	move.l	#1000,D2		;get 4th digit
	bsr	Hex3			;go convert it
Hex1:
	move.l	#1,D1			;set success flag
Hex2:
	movem.l	(A7)+,D2-D4/A0		;restore registers
	rts				;return to caller
Hex3:
	move.b	-(A0),D4		;get next byte
	subi.b	#$30,D4			;make it binary
Hex4:
	tst.b	D4			;is it zero?
	beq	Hex7			;yes, skip ahead
	subi.b	#1,D4			;no, adjust it
	add.l	D2,D0			;adjust HEX number
	bra	Hex4			;go again
Hex5:
	adda.l	#4,A7			;adjust stack
	bra	Hex2			;go return to caller
Hex6:
	adda.l	#4,A7			;adjust stack
	bsr	Hex1			;go return to caller
Hex7:
	rts				;return

********************************
*   Allocate Memory for List   *
********************************
AllocMem:
	move.l	TotalHex,d0
	mulu	#80,d0
	add.l	#80,d0		; Buffer for info & TITLE
	move.l	d0,MemoryByte

	move.l	ExecBase,a6
	move.l	MemoryByte,d0		; Byte 
	move.l	#$10001,d1		;chipmem & clear
	jsr	AllocMemory(a6)
	move.l	D0,ListStartAdres

	beq	MemoryError

	move.l	ListStartAdres,a0
	move.l	MemoryByte,d0
FullMem:
	move.l	#'    ',(a0)+
	dbf	d0,FullMem

	move.l	#MemOk,TextAdres
	bsr	Status

	rts

MemoryError:
	move.l	#MemError,TextAdres
	bsr	Status

	bsr	GetMaxDataCount
	bsr	WriteNumbers
	bsr	AllocMem

	rts

MemoryByte:	dc.l	0
ListStartAdres:	dc.l	0
MemError:	dc.b	'Not Enough Memory , Please Enter Again  '
		dc.b	'              '
MemOk:		dc.b	'OK.                                     '
		dc.b	'              '

******************************
*  Restore Allocated Memory  *
******************************
FreeMem:
	move.l	ExecBase,a6
	move.l	MemoryByte,d0
	move.l	ListStartAdres,a1
	jsr	FreeMemory(a6)
	rts

*********************************************************************
*  Free allocated memory And Clear All Data & Input New Data Count  *
*********************************************************************
NewData:
	move.l	#NewQuest,TextAdres
	bsr	Status

	move.b	KeyBuffer,d0
	not.b	d0
	lsr.b	#1,d0

	cmp.b	#$15,d0		; 'Y'
	beq	YesNew

	cmp.b	#$36,d0		; 'N'
	beq	NoNew

	clr.b	KeyBuffer
	bra	NewData
YesNew:
	bsr	FreeMem	
	bsr	GetMaxDataCount
	bsr	WriteScreen
	bsr	WriteNewNumbers
	bsr	AllocMem
NoNew:
	move.l	#84,TextX
	move.l	#30,TextY
	bsr	MoveCursor

	move.l	#MemOk,TextAdres
	move.l	#39,TextCount
	bsr	WriteText

	bra	Main

NewQuest:	dc.b	'Clear All Data Are You Sure ? (Y/N)     '
		dc.b	'              '

ListPlus:	dc.l	0
******************************
* Get New Data From Keyboard *
******************************
AddData:
	move.l	FullHex,d0
	mulu	#80,d0
	add.l	#80,d0		;for info & TITLE
	move.l	d0,ListPlus
	move.l	ListStartAdres,a5
	add.l	ListPlus,a5
	bsr	OpenInputWindow
	move.l	#NameInput,d2		; Read
	bsr	WriteWindow		; Program Name
	bsr	ReadWindow		; From Keyboard
	move.l	#19-1,d0
	move.l	#Input,a4		; Input Data Start Adress
CopyName:
	cmp.b	#$0a,(a4)
	beq	NameOk
	move.b	(a4)+,(a5)+
	dbf	d0,CopyName

NameOk:
	move.l	ListStartadres,a5
	add.l	ListPlus,a5
	add.l	#20,a5			; find ID start
	move.l	#IDInput,d2		; Read
	bsr	WriteWindow		; Program ID
	bsr	ReadWindow		; From Keyboard
	move.l	#5-1,d0
	move.l	#Input,a4
CopyID:
	cmp.b	#$0A,(a4)
	beq	IDOk
	move.b	(a4)+,(a5)+
	dbf	d0,CopyID

IDOk:
	move.l	ListStartAdres,a5
	add.l	ListPlus,a5
	add.l	#26,a5
	move.l	#LenghtInput,d2		; Read
	bsr	WriteWindow		; Program Lenght
	bsr	ReadWindow		; From Keyboard
	move.l	#6-1,d0
	move.l	#Input,a4
CopyLenght:
	cmp.b	#$0a,(a4)
	beq	LenghtOk
	move.b	(a4)+,(a5)+
	dbf	d0,CopyLenght

LenghtOk:
	move.l	ListStartAdres,a5
	add.l	ListPlus,a5
	add.l	#33,a5
	move.l	#DateInput,d2		; Read
	bsr	WriteWindow		; Input Date
	bsr	ReadWindow		; From Keyboard
	move.l	#8-1,d0
	move.l	#Input,a4
CopyDate:
	cmp.b	#$0a,(a4)
	beq	DateOk
	move.b	(a4)+,(a5)+
	dbf	d0,CopyDate

DateOk:
	move.l	ListStartAdres,a5
	add.l	ListPlus,a5
	add.l	#42,a5
	move.l	#KickInput,d2		; Read
	bsr	WriteWindow		; KickStart Version
	bsr	ReadWindow		; From Keyboard
	move.l	#[4-1],d0
	move.l	#Input,a4
CopyKick:
	cmp.b	#$0a,(a4)
	beq	KickOk
	move.b	(a4)+,(a5)+
	dbf	d0,CopyKick

KickOk:
	move.l	ListStartAdres,a5
	add.l	ListPlus,a5
	add.l	#47,a5
	move.l	#MemoryInput,d2		; Read
	bsr	WriteWindow		; Enough Memory
	bsr	ReadWindow		; From Keyboard
	move.l	#[6-1],d0
	move.l	#Input,a4
CopyMemory:
	cmp.b	#$0a,(a4)
	beq	MemoryOk
	move.b	(a4)+,(a5)+
	dbf	d0,CopyMemory

MemoryOk:
	move.l	ListStartAdres,a5
	add.l	ListPlus,a5
	add.l	#54,a5
	move.l	#ExplainInput,d2	; Read
	bsr	WriteWindow		; Program Type
	bsr	ReadWindow		; From Keyboard
	move.l	#26-1,d0
	move.l	#Input,a4
CopyExplain:
	cmp.b	#$0a,(a4)
	beq	ExplainOk
	move.b	(a4)+,(a5)+
	dbf	d0,CopyExplain

ExplainOk:
	bsr	CloseInputWindow

	move.l	#MemOk,TextAdres
	bsr	Status

	add.l	#1,FullHex
	sub.l	#1,FreeHex
	move.l	FullHex,ActiveHex
	bsr	WriteNewNumbers

	bra	Main

WriteNewNumbers:
	lea	FullHex,a0
	bsr	HexToDec
	move.l	Buffer,FullASCII

	lea	ActiveHex,a0
	bsr	HexToDec
	move.l	Buffer,ActiveASCII

	lea	FreeHex,a0
	bsr	HexToDec
	move.l	Buffer,FreeASCII

	bsr	WriteNumbers
	bsr	WriteDatas

	rts

****************************
*  Hex To Dec Converter    *
*  a0 = Hex Number adress  *
*  Buffer = ASCII String   *
****************************

HexToDec:
	move.l	#'0000',Buffer
	move.b	#'0',Buffer+3
	move.l	#Buffer,A1
	move.l	(A0),A0
	move.l	A0,D0
	move.l	#1000,D2
	move.l	#00,D3
X121:
	cmp.l	D2,A0
	bcs	X120
	divu	D2,D0
	move.b	D0,D1
	add.b	#$30,D1
	move.b	D1,(A1,D3)
	lsr	#8,D0
	swap	D0
X120:
	divu	#10,D2
	addq.l	#1,D3
	cmp.l	#05,D3
	bne	X121
	rts

Buffer:		dc.l	0

***
OpenInputWindow:
	move.l	DosBase,a6
	move.l	#WindowData,d1
	move.l	#1006,d2	;Mode Old File
	jsr	Open(a6)	;Open Window
	move.l	d0,InputWindow
	rts

InputWindow:	dc.l	0
WindowData:	dc.b	'CON:10/159/615/88/TST Sorter Input Window  ',0

**

CloseInputWindow:
	move.l	DosBase,a6
	move.l	InputWindow,d1
	jsr	Close(a6)	; CloseWindow
	rts

**  D2 Message
WriteWindow:
	move.l	DosBase,a6
	move.l	d2,a0
	moveq	#0,d3
CalcLength:
	add.l	#1,d3
	cmp.b	#0,(a0)+
	bne	CalcLength
	sub.l	#1,d3
	move.l	InputWindow,d1
	jsr	Write(a6)
	rts
NameInput:	dc.b	$0a,$0d,'      Program Name (Max. 19 Char.): ',0
IDInput:	dc.b	'                 ID (Max. 5 Char.): ',0
LenghtInput:	dc.b	'             Lenght (Max. 6 Char.): ',0   
DateInput:	dc.b	'               Date (Max. 8 Char.): ',0
KickInput:	dc.b	'  KickStart Version (Max. 4 Char.): ',0
MemoryInput:	dc.b	'             Memory (Max. 6 Char.): ',0
ExplainInput:	dc.b	'           Explain (Max. 26 Char.): ',0
even
**
ReadWindow:
	move.l	#Input,a6
	move.l	#64,d1
Clr:
	move.b	#" ",(a6)+		;Clear Input Buffer
	dbf	d1,Clr

	move.l	DosBase,a6
	move.l	InputWindow,d1
	move.l	#Input,d2
	move.l	#62,d3
	jsr	Read(a6)
	rts

Input:	blk.b	65	;input max 40 character
even
***************************
*  Write Datas To Screen  *
***************************
WriteDatas:
	move.l	ActiveHex,d6
;	sub.l	#1,d6    	; for info & TITLE
	mulu	#80,d6

	move.l	ListStartAdres,a3
	add.l	d6,a3		;First data's adres
	move.l	a3,EWStart
	move.l	#YCoords,a5

	bsr	SPenReverse
	clr.l	d4

WCont:
	cmp.l	FullHex,d4
	beq	WriteEnd4
	add.l	#1,d4
	cmp.l	#13,d4
	beq	WriteEnd1
	move.l	(a5)+,YCoord
	bsr	WriteEdited
	bsr	SetPenNorm
	add.l	#80,EWStart
	bra	WCont

WriteEnd1:
	move.l	a3,EWStart
	move.l	ActiveHex,d5
WE1Loop:
	sub.l	#1,d5
	cmp.l	#0,d5
	ble	WriteEnd2
	add.l	#1,d4
	cmp.l	#26,d4
	beq	WriteEnd
	sub.l	#80,EWStart
	move.l	(a5)+,YCoord
	bsr	WriteEdited
	bsr	SetPenNorm
	bra	WE1Loop
WriteEnd2:
	bsr	SetPenNorm
WriteEnd3:
	move.l	(a5)+,YCoord
	cmp.l	#$ffffffff,YCoord
	beq	WriteEnd
	move.l	#Space,EWStart	
	bsr	WriteEdited
	bra	WriteEnd3
WriteEnd4:
	bsr	SetPenNorm
	add.l	#1,d4
	cmp.l	#13,d4
	beq	WriteEnd1
	move.l	#Space,EWStart
	move.l	(a5)+,YCoord
	bsr	WriteEdited
	bra	WriteEnd4
SetPenNorm:
	move.l	GfxBase,a6
	move.l	Rastport,a1
	move.l	#1,d0
	jsr	SetApen(a6)

	move.l	GfxBase,a6
	move.l	Rastport,a1
	move.l	#0,d0
	jsr	SetBpen(a6)
	rts	
SPenReverse:
	move.l	GfxBase,a6
	move.l	Rastport,a1
	move.l	#0,d0
	jsr	SetApen(a6)

	move.l	GfxBase,a6
	move.l	Rastport,a1
	move.l	#1,d0
	jsr	SetBpen(a6)
WriteEnd:
	rts

even
YCoords:
	dc.l	156,164,172,180,188,196,204,212,220,228,236,244
	dc.l	148,140,132,124,116,108,100,92,84,76,68,60,$ffffffff
Space:		blk.b	90,$20
*************************
***  Change title  ******
*************************
ChangeTitle:

	bsr	OpenInputWindow
	move.l	#TitleQuestion,d2	;Read
	bsr	WriteWindow		;TITLE
	bsr	ReadWindow		;From Keyboard
	bsr	CloseInputWindow

	move.l	#Input,a4
	move.l	ListStartAdres,a5
	move.l	#60-1,d0	; character count
	add.l	#20,a5		; find title start
ClearTitle:
	move.b	#' ',(a5)+
	dbf	d0,ClearTitle

	sub.l	#60,a5		; find title start
	move.l	#60-1,d0	; character count
TitleCopy:
	cmp.b	#$0a,(a4)
	beq	TitleOk
	move.b	(a4)+,(a5)+
	dbf	d0,TitleCopy
TitleOk:
	bsr	TitleWrite
	clr.b	KeyBuffer
	bra	Main
TitleWrite:
	move.l	#70,TextX
	move.l	#40,TextY
	bsr	MoveCursor

	move.l	ListStartAdres,a5
	add.l	#20,a5
	move.l	a5,TextAdres
	move.l	#60,TextCount
	bsr	WriteText
	rts

TitleQuestion:	dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	'                Input New Title (max 60 Char) :'
		dc.b	$0d,$0a,$0d,$0a,'      '
*********************************
******  TITLE END    ************
*********************************

*********************************
********   SAVE DATA   **********
*********************************
even
SaveData:

	bsr	GetFileName

	move.l	ListStartAdres,a1
	lea	Beyaz,a2
	move.l	#8-1,d0
CopyBeyaz:
	move.b	(a2)+,(a1)+
	dbf	d0,CopyBeyaz	

	move.l	FullHex,(a1)+

** Open New File
	move.l	DosBase,a6
	move.l	#DName,d1	; Point to the filename
	move.l	#ModeNew,d2	; Mode NewFile
	jsr	Open(a6)
	move.l	d0,WFileHandle
	beq	OpenError

	move.l	#Writing,TextAdres
	bsr	Status

	move.l	DosBase,a6
	move.l	WFileHandle,d1
	move.l	ListStartAdres,d2
	move.l	FullHex,d3
	mulu	#80,d3		; lenght
	add.l	#80,d3		; for info & title
	jsr	Write(a6)

	cmp.l	d3,d0
	beq	WriteOk

	move.l	#WriteError,TextAdres
	bsr	Status
WriteOk:
	move.l	#MemOk,TextAdres
	bsr	Status

	move.l	DosBase,a6
	move.l	WFileHandle,d1
	jsr	Close(a6)	

	clr.b	KeyBuffer
	bra	Main
OpenError:
	move.l	#OError,TextAdres
	bsr	Status

	clr.b	KeyBuffer
	bra	Main

OError:		dc.b	'OPEN ERROR !!!!                         '
		dc.b	'              '
WriteError:	dc.b	'WRITE ERROR !!!!!                       '
		dc.b	'              '
Writing:	dc.b	'Please Wait     SAVING.........         '
		dc.b	'              '
WFileHandle:	dc.l	0
Beyaz:		dc.b	'BEYAZtst'
DName:		blk.b	64,0
DNameQuestion:	dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	'        Pease Insert Name (Max 40 Char): ',0
even
***********  Get FileName From Keyboard  *******************
GetFileName: 
	bsr	OpenInputWindow
	move.l	#DNameQuestion,d2	;Read
	bsr	WriteWindow		;data name
	bsr	ReadWindow		;From Keyboard
	bsr	CloseInputWindow
CopyDirName:
	move.l	#Input,a4
	move.l	#DName,a5
	move.l	#60-1,d0	; character count
ClearDName:
	move.b	#0,(a5)+
	dbf	d0,ClearDName

	sub.l	#60,a5		; find name start
	move.l	#60-1,d0	; character count
DNameCopy:
	cmp.b	#$0a,(a4)
	beq	DNameOk
	move.b	(a4)+,(a5)+
	dbf	d0,DNameCopy
DNameOk:
	rts
************************************************************************

***************************
*****  LOAD DATA  *********
***************************
LoadData:
	bsr	GetFileName

	move.l	DosBase,a6
	move.l	#DName,d1	; Point to the filename
	move.l	#ModeOld,d2	; Mode OldFile
	jsr	Open(a6)
	move.l	d0,RFileHandle
	beq	OpenError

	move.l	DosBase,a6
	move.l	RFileHandle,d1
	move.l	ListStartAdres,d2
	move.l	#80,d3
	jsr	Read(a6)
	cmp.l	d0,d3
	bne	LoadError

	move.l	#Beyaz,a0
	move.l	ListStartAdres,a1
	move.l	#8-1,d0
	clr.l	d1
	clr.l	d2
Compare:
	move.b	(a0)+,d1
	move.b	(a1)+,d2
	cmp.b	d1,d2
	bne	WrongDataError
	dbf	d0,Compare

	move.l	ListStartAdres,a1
	add.l	#8,a1
	move.l	(a1),FullHex

	move.l	FullHex,d0
	move.l	TotalHex,d1
	cmp.l	d1,d0
	bgt	BigDataError

	move.l	ListStartAdres,a0
	add.l	#80,a0
	move.l	MemoryByte,d0
	sub.l	#80,d0
LFullMem:
	move.l	#'    ',(a0)+
	dbf	d0,LFullMem

	bsr	WriteScreen

	move.l	#Loading,TextAdres
	bsr	Status

	move.l	FullHex,d3
	mulu	#80,d3
	move.l	DosBase,a6
	move.l	RFileHandle,d1
	move.l	ListStartAdres,d2
	add.l	#80,d2
	jsr	Read(a6)
	cmp.l	d0,d3
	bne	LoadError

	bsr	CloseLFile

	move.l	TotalHex,d0
	sub.l	FullHex,d0
	move.l	d0,FreeHex
	move.l	#1,ActiveHex

	move.l	#Loaded,TextAdres
	bsr	Status

	bsr	WriteNewNumbers
	bsr	TitleWrite

	clr.b	KeyBuffer
	bra	Main
CloseLFile:
	move.l	DosBase,a6
	move.l	RFileHandle,d1
	jsr	Close(a6)
	rts
BigDataError:
	move.l	#BigError,TextAdres
	bsr	Status
	bra	ErrorExit
WrongDataError:
	move.l	#NotData,TextAdres
	bsr	Status
	bra	ErrorExit
LoadError:	
	bsr	CloseLFile
	move.l	#LoadErrorText,TextAdres
	bsr	Status
ErrorExit:
	move.l	ListStartAdres,a0
	move.l	FullHex,d0
	add.l	#80,d0
	divu	#4,d0
ClearError:
	move.l	'    ',(a0)+
	dbf	d0,ClearError

	move.l	#0,FullHex
	move.l	TotalHex,FreeHex
	move.l	#1,ActiveHex

	bsr	WriteNewNumbers
	clr.b	KeyBuffer
	bra	Main

RFileHandle:	dc.l	0
Loaded:		dc.b	'LOAD OK.                                '
		dc.b	'              '
Loading:	dc.b	'Please Wait  LOADING.........           '
		dc.b	'              '
LoadErrorText:	dc.b	'LOAD ERROR !!!!                         '
		dc.b	'              '
NotData:	dc.b	'This Is Not TST SORTER DATA FILE !!!!   '
		dc.b	'              '
BigError:	dc.b	'File Is TOO BIG !!!!!!                  '
		dc.b	'              '
even
****************************************************************
******  ONE DATA BACKWARD  ********
***********************************
OneForWard:
	cmp.l	#1,ActiveHex
	ble	OneFOk
	sub.l	#1,ActiveHex
	bsr	WriteNewNumbers
OneFOk:
	clr.b	KeyBuffer
	bra	Main
*****************************************************************
********  ONE DATA FORWARD  *******
***********************************
OneBackWard:
	clr.l	d0
	clr.l	d1
	move.l	ActiveHex,d0
	move.l	FullHex,d1
	cmp.l	d1,d0
	bge	OneBackOk
	add.l	#1,ActiveHex
	bsr	WriteNewNumbers
OneBackOk:
	clr.b	KeyBuffer
	bra	Main
******************************************************************
*******  ONE PAGE BACKWARD  *******
***********************************
OnePageBack:
	cmp.l	#0,FullHex
	beq	Main
	cmp.l	#23,ActiveHex
	ble	OnePageOk
	sub.l	#23,ActiveHex
	bsr	WriteNewNumbers	
	clr.b	KeyBuffer
	bra	Main
OnePageOk:
	move.l	#1,ActiveHex
	bsr	WriteNewNumbers
	clr.b	KeyBuffer
	bra	Main
******************************************************************
********  ONE DATA FORWARD  *******
***********************************
OnePageForw:
	cmp.l	#0,FullHex
	beq	Main
	move.l	ActiveHex,d0
	add.l	#23,d0
	cmp.l	FullHex,d0
	bgt	OnePageFOk
	add.l	#23,ActiveHex
	bsr	WriteNewNumbers
	clr.b	KeyBuffer
	bra	Main
OnePageFOk:
	move.l	FullHex,ActiveHex
	bsr	WriteNewNumbers
	clr.b	KeyBuffer
	bra	Main
************************************************************************
***********  EDIT ACTIVE DATA  ************
*******************************************
EditData:
	cmp.l	#0,FullHex
	beq	EditOk2

	move.l	#EditQuest,TextAdres
	bsr	Status
GetEditKey:
	move.b	KeyBuffer,d0
	not.b	d0
	lsr.b	#1,d0

	cmp.b	#$36,d0		; 'N'
	beq	EditName

	cmp.b	#$17,d0		; 'I'
	beq	EditId

	cmp.b	#$28,d0		; 'L'
	beq	EditLenght

	cmp.b	#$22,d0		; 'D'
	beq	EditDate

	cmp.b	#$27,d0		; 'K'
	beq	EditKick

	cmp.b	#$37,d0		; 'M'
	beq	EditMemory

	cmp.b	#$12,d0		; 'E'
	beq	EditExplain

	bra	GetEditKey
EditName:
	move.l	#NQuest,QuestionAdres
	bsr	GetData
	bsr	FindStart
	move.l	#0,EAddLenght
	move.l	#19-1,ECount
	bsr	Edit
	bsr	SPenReverse	
	move.l	#156,YCoord
	bsr	WriteEdited
	bsr	SetPenNorm
	clr.b	KeyBuffer
	bra	Main
EditId:
	move.l	#IQuest,QuestionAdres
	bsr	GetData
	bsr	FindStart
	move.l	#20,EAddLenght
	move.l	#5-1,ECount
	bsr	Edit
	bsr	SPenReverse	
	move.l	#156,YCoord
	bsr	WriteEdited
	bsr	SetPenNorm
	clr.b	KeyBuffer
	bra	Main
EditLenght:
	move.l	#LQuest,QuestionAdres
	bsr	GetData
	bsr	FindStart
	move.l	#26,EAddLenght
	move.l	#6-1,ECount
	bsr	Edit
	bsr	SPenReverse	
	move.l	#156,YCoord
	bsr	WriteEdited
	bsr	SetPenNorm
	clr.b	KeyBuffer
	bra	Main
EditDate:
	move.l	#DQuest,QuestionAdres
	bsr	GetData
	bsr	FindStart
	move.l	#33,EAddLenght
	move.l	#8-1,ECount
	bsr	Edit
	bsr	SPenReverse	
	move.l	#156,YCoord
	bsr	WriteEdited
	bsr	SetPenNorm
	clr.b	KeyBuffer
	bra	Main
EditKick:
	move.l	#KQuest,QuestionAdres
	bsr	GetData
	bsr	FindStart
	move.l	#42,EAddLenght
	move.l	#4-1,ECount
	bsr	Edit
	bsr	SPenReverse	
	move.l	#156,YCoord
	bsr	WriteEdited
	bsr	SetPenNorm
	clr.b	KeyBuffer
	bra	Main
EditMemory:
	move.l	#MQuest,QuestionAdres
	bsr	GetData
	bsr	FindStart
	move.l	#47,EAddLenght
	move.l	#6-1,ECount
	bsr	Edit
	bsr	SPenReverse	
	move.l	#156,YCoord
	bsr	WriteEdited
	bsr	SetPenNorm
	clr.b	KeyBuffer
	bra	Main
EditExplain:
	move.l	#EQuest,QuestionAdres
	bsr	GetData
	bsr	FindStart
	move.l	#54,EAddLenght
	move.l	#26-1,ECount
	bsr	Edit
	bsr	SPenReverse	
	move.l	#156,YCoord
	bsr	WriteEdited
	bsr	SetPenNorm
EditOk2:
	clr.b	KeyBuffer
	bra	Main
GetData:
	move.l	#MemOk,TextAdres
	bsr	Status
	bsr	OpenInputWindow
	move.l	QuestionAdres,d2	;Read
	bsr	WriteWindow		;data name
	bsr	ReadWindow		;From Keyboard
	bsr	CloseInputWindow
	rts
FindStart:
	move.l	ListStartAdres,a0
	move.l	ActiveHex,d1
	mulu	#80,d1
	add.l	d1,a0
	move.l	a0,EWStart
	rts
Edit:
	add.l	EAddLenght,a0
	move.l	ECount,d1
EditClear:
	move.b	#' ',(a0)+
	dbf	d1,EditClear

	move.l	EWStart,a0
	add.l	EAddLenght,a0
	move.l	#Input,a1		; Input Data Start Adress
	move.l	ECount,d0
EditCopy:
	cmp.b	#$0a,(a1)
	beq	EditOk
	move.b	(a1)+,(a0)+
	dbf	d0,EditCopy
EditOk:
	rts
WriteEdited:
	movem.l	d0-d7/a0-a6,-(SP)	; save registers

	move.l	#7-1,d5
	move.l	EWStart,a4	
	move.l	#AdresPlus,a2
	move.l	#XDatas,a5
	move.l	#ECounts,a3
EWrite:
	move.l	GfxBase,a6
	move.l	Rastport,a1
	move.l	(a5)+,d0	; X Coord.
	move.l	YCoord,d1	; Y Coord.
	jsr	Move(a6)	; Move Cursor

	add.l	(a2)+,a4
	move.l	a4,a0		; Text
	move.l	(a3)+,d0	; Count
	jsr	Text(a6)	; Write  Text

	dbf	d5,EWrite

	movem.l	(SP)+,d0-d7/a0-a6
	rts
YCoord:		dc.l	0
AdresPlus:	dc.l	0,20,6,7,9,5,7
XDatas:		dc.l	0,160,208,264,336,376,432
ECounts:	dc.l	19,5,6,8,4,6,26
EWStart:	dc.l	0
EAddLenght:	dc.l	0
ECount:		dc.l	0
QuestionAdres:	dc.l	0
EditQuest:	dc.b	'(N)ame (I)d (L)enght (D)ate (K)ick (M)emory '
		dc.b	'(E)xplain '
NQuest:		dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	'    New Name (Max 19 Char) :',0
IQuest:		dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	'       New Id (Max 5 Char) :',0
LQuest:		dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	'   New Lenght (Max 6 Char) :',0
DQuest:		dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	'     New Date (Max 8 Char) :',0
KQuest:		dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	' New KickStart Version (Max 4 Char) :',0
MQuest:		dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	'   New Memory (Max 6 Char) :',0
EQuest:		dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	' New Explain (Max 26 Char) :',0
*******************************************************************
****************  DELETE ACTIVE DATA  *******************
*********************************************************
DeleteData:
	cmp.l	#0,FullHex
	beq	DeleteEnd
	move.l	ActiveHex,d6
;	sub.l	#1,d6    	; for info & TITLE
	mulu	#80,d6

	move.l	ListStartAdres,a3
	add.l	d6,a3		;First data's adres
	move.l	a3,a4
	add.l	#80,a3
	move.l	ActiveHex,d1
DCopyLoop:
	cmp.l	FullHex,d1
	beq	DeleteEnd2
	move.l	#[80/4]-1,d0
DCopy:
	move.l	(a3)+,(a4)+
	dbf	d0,DCopy
	add.l	#1,d1
	bra	DCopyLoop
DeleteEnd2:
	move.l	#[80/4]-1,d0
DClear:
	move.l	#'    ',(a4)+
	dbf	d0,DClear
	move.l	ActiveHex,d1
	cmp.l	FullHex,d1
	bne	DeleteEnd3
	sub.l	#1,ActiveHex
DeleteEnd3:
	sub.l	#1,FullHex
	add.l	#1,FreeHex
	bsr	WriteNewNumbers
	move.l	#Deleted,TextAdres
	bsr	Status
DeleteEnd:
	clr.b	KeyBuffer
	bra	Main
Deleted:	dc.b	'Active Data DELETED !!!!!!              '
		dc.b	'              '
*********************************************************************
********   FIND DATA  **************
************************************
FindData:
	cmp.l	#1,FullHex
	ble	FindOk

	move.l	#EditQuest,TextAdres
	bsr	Status
GetFindKey:
	move.b	KeyBuffer,d0
	not.b	d0
	lsr.b	#1,d0

	cmp.b	#$36,d0		; 'N'
	beq	FindName

	cmp.b	#$17,d0		; 'I'
	beq	FindId

	cmp.b	#$28,d0		; 'L'
	beq	FindLenght

	cmp.b	#$22,d0		; 'D'
	beq	FindDate

	cmp.b	#$27,d0		; 'K'
	beq	FindKick

	cmp.b	#$37,d0		; 'M'
	beq	FindMemory

	cmp.b	#$12,d0		; 'E'
	beq	FindExplain

	bra	GetFindKey
FindName:
	move.l	#FNQuest,QuestionAdres
	bsr	GetData
	move.l	#0,Which
	move.l	#0,FoundFlag2
	move.l	#19+1,TotalChar
	move.l	#Searching,TextAdres
	bsr	Status
	bsr	Search
	bsr	WriteNewNumbers
	bra	FindOk
FindId:
	move.l	#FIQuest,QuestionAdres
	bsr	GetData
	move.l	#20,Which
	move.l	#0,FoundFlag2
	move.l	#5+1,TotalChar
	move.l	#Searching,TextAdres
	bsr	Status
	bsr	Search
	bsr	WriteNewNumbers
	bra	FindOk
FindLenght:
	move.l	#FLQuest,QuestionAdres
	bsr	GetData
	move.l	#26,Which
	move.l	#0,FoundFlag2
	move.l	#6+1,TotalChar
	move.l	#Searching,TextAdres
	bsr	Status
	bsr	Search
	bsr	WriteNewNumbers
	bra	FindOk
FindDate:
	move.l	#FDQuest,QuestionAdres
	bsr	GetData
	move.l	#33,Which
	move.l	#0,FoundFlag2
	move.l	#8+1,TotalChar
	move.l	#Searching,TextAdres
	bsr	Status
	bsr	Search
	bsr	WriteNewNumbers
	bra	FindOk
FindKick:
	move.l	#FKQuest,QuestionAdres
	bsr	GetData
	move.l	#42,Which
	move.l	#0,FoundFlag2
	move.l	#4+1,TotalChar
	move.l	#Searching,TextAdres
	bsr	Status
	bsr	Search
	bsr	WriteNewNumbers
	bra	FindOk
FindMemory:
	move.l	#FMQuest,QuestionAdres
	bsr	GetData
	move.l	#47,Which
	move.l	#0,FoundFlag2
	move.l	#6+1,TotalChar
	move.l	#Searching,TextAdres
	bsr	Status
	bsr	Search
	bsr	WriteNewNumbers
	bra	FindOk
FindExplain:
	move.l	#FEQuest,QuestionAdres
	bsr	GetData
	move.l	#54,Which
	move.l	#0,FoundFlag2
	move.l	#26+1,TotalChar
	move.l	#Searching,TextAdres
	bsr	Status
	bsr	Search
	bsr	WriteNewNumbers
	bra	FindOk

Search:
	move.l	ActiveHex,ActiveBuffer
	move.l	ActiveHex,d6
	clr.l	d3
	move.l	FullHex,d2

	move.l	TotalChar,d4
	move.l	#SData,a1
ClearSData:
	move.b	#' ',(a1)+
	dbf	d4,ClearSData

	move.l	TotalChar,d4
	sub.l	#1,d4
	move.l	#input,a0
	move.l	#SData,a1
CopySData:
	cmp.b	#$0a,(a0)
	beq	SLoop
	move.b	(a0)+,(a1)+
	dbf	d4,CopySData

SLoop:
	move.l	d6,ActiveHex

	move.l	#SData,a0
	move.l	ListStartAdres,a2
	move.l	ActiveHex,d1
	mulu	#80,d1
	add.l	d1,a2		; Find Active data start adres
	add.l	Which,a2	; Name or Id or ......

	move.l	TotalChar,d4
	move.l	#0,FoundFlag
	cmp.l	d6,d2
	blt	NotFound
	add.l	#1,d6
SAgain:
	move.b	(a0)+,d3
	cmp.b	(a2)+,d3
	bne	SLoop
	add.l	#1,FoundFlag
	sub.l	#1,d4
	beq	Found
	move.l	FoundFlag2,d5
	cmp.l	FoundFlag,d5
	bge	SAgain
	move.l	FoundFlag,FoundFlag2
	move.l	ActiveHex,ActiveBuffer
	bra	SAgain

NotFound:
	move.l	#NotFoundT,TextAdres
	bsr	Status
	move.l	ActiveBuffer,ActiveHex
	rts
Found:
	move.l	#FoundT,TextAdres
	bsr	Status
	move.l	ActiveBuffer,ActiveHex
	rts
FindOk:
	clr.b	KeyBuffer
	bra	Main
ActiveBuffer:	dc.l	0
Which:		dc.l	0
TotalChar:	dc.l	0
FoundFlag:	dc.l	0
FoundFlag2:	dc.l	0
FNQuest:	dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	'  Search Name (Max 19 Char) :',0
FIQuest:	dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	'     Search Id (Max 5 Char) :',0
FLQuest:	dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	' Search Lenght (Max 6 Char) :',0
FDQuest:	dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	'   Search Date (Max 8 Char) :',0
FKQuest:	dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	'   Search Kick (Max 4 Char) :',0
FMQuest:	dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	' Search Memory (Max 6 Char) :',0
FEQuest:	dc.b	$0d,$0a,$0d,$0a,$0d,$0a
		dc.b	' Search Explain (Max 26 Char) :',0
Searching:	dc.b	'SEARCHING..........                     '	
		dc.b	'              '
FoundT:		dc.b	'Data Found............                  '
		dc.b	'              '
NotFoundT:	dc.b	'Data NOT Found !!!!!!!!                 '
		dc.b	'              '
even
SData:		blk.b	30,$20
*********************************************************************
*********  SORT LISTE  ************
***********************************
SortData:
	cmp.l	#2,FullHex
	ble	SortOk

	move.l	#EditQuest,TextAdres
	bsr	Status
GetSortKey:
	move.b	KeyBuffer,d0
	not.b	d0
	lsr.b	#1,d0

	cmp.b	#$36,d0		; 'N'
	beq	SortName

	cmp.b	#$17,d0		; 'I'
	beq	SortId

	cmp.b	#$28,d0		; 'L'
	beq	SortLenght

	cmp.b	#$22,d0		; 'D'
	beq	SortDate

	cmp.b	#$27,d0		; 'K'
	beq	SortKick

	cmp.b	#$37,d0		; 'M'
	beq	SortMemory

	cmp.b	#$12,d0		; 'E'
	beq	SortExplain

	bra	GetSortKey
SortName:
	move.l	#0,Which
	move.l	#19-1,TotalChar
	move.l	#Sorting,TextAdres
	bsr	Status
	bsr	Sort
	move.l	#MemOk,TextAdres
	bsr	Status
	move.l	#1,ActiveHex
	bsr	WriteNewNumbers
	bra	SortOk
SortId:
	move.l	#20,Which
	move.l	#5-1,TotalChar
	move.l	#Sorting,TextAdres
	bsr	Status
	bsr	Sort
	move.l	#MemOk,TextAdres
	bsr	Status
	move.l	#1,ActiveHex
	bsr	WriteNewNumbers
	bra	SortOk
SortLenght:
	move.l	#26,Which
	move.l	#6-1,TotalChar
	move.l	#Sorting,TextAdres
	bsr	Status
	bsr	Sort
	move.l	#MemOk,TextAdres
	bsr	Status
	move.l	#1,ActiveHex
	bsr	WriteNewNumbers
	bra	SortOk
SortDate:
	move.l	#33,Which
	move.l	#8-1,TotalChar
	move.l	#Sorting,TextAdres
	bsr	Status
	bsr	Sort
	move.l	#MemOk,TextAdres
	bsr	Status
	move.l	#1,ActiveHex
	bsr	WriteNewNumbers
	bra	SortOk
SortKick:
	move.l	#42,Which
	move.l	#4-1,TotalChar
	move.l	#Sorting,TextAdres
	bsr	Status
	bsr	Sort
	move.l	#MemOk,TextAdres
	bsr	Status
	move.l	#1,ActiveHex
	bsr	WriteNewNumbers
	bra	SortOk
SortMemory:
	move.l	#47,Which
	move.l	#6-1,TotalChar
	move.l	#Sorting,TextAdres
	bsr	Status
	bsr	Sort
	move.l	#MemOk,TextAdres
	bsr	Status
	move.l	#1,ActiveHex
	bsr	WriteNewNumbers
	bra	SortOk
SortExplain:
	move.l	#54,Which
	move.l	#26-1,TotalChar
	move.l	#Sorting,TextAdres
	bsr	Status
	bsr	Sort
	move.l	#MemOk,TextAdres
	bsr	Status
	move.l	#1,ActiveHex
	bsr	WriteNewNumbers
	bra	SortOk
Sort:
	move.l	#0,SortFlag
	move.l	#0,ActiveHex
SortCont:
	add.l	#1,ActiveHex
	move.l	ListStartAdres,a0
	move.l	ActiveHex,d0
	cmp.l	FullHex,d0
	beq	SOk

	mulu	#80,d0
	add.l	d0,a0
	add.l	Which,a0	; find string start
	move.l	a0,a1
	add.l	#80,a1		; second string
	move.l	TotalChar,d5
SCompare:
	move.b	(a0)+,d4
	cmp.b	(a1)+,d4
	bgt	Swap
	bne	SortCont
	dbf	d5,SCompare
	bra	SortCont
Swap:
	move.l	ListStartAdres,a2
	move.l	ActiveHex,d1
	mulu	#80,d1
	add.l	d1,a2
	move.l	a2,a3
	move.l	#80-1,d3	; string lenght
	move.l	#SortBuffer,a4
SBufferCopy:
	move.b	(a2)+,(a4)+	
	dbf	d3,SBufferCopy
	move.l	a3,a2
	add.l	#80,a3		; second string start adres
	move.l	#80-1,d3
SSecondCopy:
	move.b	(a3)+,(a2)+
	dbf	d3,SSecondCopy
	move.l	#80-1,d3
	move.l	#SortBuffer,a3
SFirstCopy:
	move.b	(a3)+,(a2)+
	dbf	d3,SFirstCopy
	move.l	#1,SortFlag
	bra	SortCont
SOk:
	cmp.l	#0,SortFlag
	bne	Sort
	rts

SortOk:
	clr.b	KeyBuffer
	bra	Main
SortFlag:	dc.l	0
SortBuffer:	blk.b	80,20
Sorting:	dc.b	'Please Wait SORTING .......             '
		dc.b	'              '
even
******************************************************************
************  MERGE DATA WITH ANOTHER FILE  *********************
*****************************************************************
MergeData:
	move.l	ListStartAdres,a0
	move.l	FullHex,d0
	mulu	#80,d0
	add.l	d0,a0
	move.l	a0,MergeStart
	move.l	#MergeBuffer,a1
	move.l	#80-1,d0
MCopy:
	move.b	(a0)+,(a1)+
	dbf	d0,MCopy

	cmp.l	#0,Fullhex
	beq	MergeOk

MLoadData:
	bsr	GetFileName

	move.l	DosBase,a6
	move.l	#DName,d1	; Point to the filename
	move.l	#ModeOld,d2	; Mode OldFile
	jsr	Open(a6)
	move.l	d0,RFileHandle
	beq	OpenError

	move.l	DosBase,a6
	move.l	RFileHandle,d1
	move.l	MergeStart,d2
	move.l	#80,d3
	jsr	Read(a6)
	cmp.l	d0,d3
	bne	MErrorExit

	move.l	#Beyaz,a0
	move.l	MergeStart,a1
	move.l	#8-1,d0
	clr.l	d1
	clr.l	d2
MCompare:
	move.b	(a0)+,d1
	move.b	(a1)+,d2
	cmp.b	d1,d2
	bne	MWrongDataError
	dbf	d0,MCompare

	move.l	MergeStart,a1
	add.l	#8,a1
	move.l	(a1),MFullHex

	move.l	MFullHex,d0
	add.l	Fullhex,d0
	move.l	TotalHex,d1
	cmp.l	d1,d0
	bgt	MBigDataError

	move.l	#Loading,TextAdres
	bsr	Status

	move.l	DosBase,a6
	move.l	MFullHex,d3
	mulu	#80,d3
	move.l	MergeStart,d2
	add.l	#80,d2
	move.l	RFileHandle,d1
	jsr	Read(a6)
	cmp.l	d0,d3
	bne	MLoadError

	bsr	MCloseLFile

	move.l	TotalHex,d0
	move.l	FullHex,d1
	move.l	FullHex,ActiveHex
	add.l	MFullHex,d1
	move.l	d1,FullHex
	sub.l	d1,d0
	move.l	d0,FreeHex


	move.l	#Loaded,TextAdres
	bsr	Status

MergeOk:
	move.l	MergeStart,a0
	move.l	#MergeBuffer,a1
	move.l	#80-1,d0
MACopy:
	move.b	(a1)+,(a0)+
	dbf	d0,MACopy
	bsr	WriteNewNumbers
	bsr	TitleWrite
	clr.b	KeyBuffer
	bra	Main
MCloseLFile:
	move.l	DosBase,a6
	move.l	RFileHandle,d1
	jsr	Close(a6)
	rts
MBigDataError:
	move.l	#BigError,TextAdres
	bsr	Status
	bra	MErrorExit2
MWrongDataError:
	move.l	#NotData,TextAdres
	bsr	Status
	bra	MErrorExit2
MLoadError:	
	move.l	ListStartAdres,a0
	move.l	MFullHex,d0
	mulu	#80,d0
	move.l	FullHex,d1
	add.l	#1,d1		; for info & title
	mulu	#80,d1
	add.l	d1,a0
	sub.l	#1,d0
MClear:
	move.b	#' ',(a0)+
	dbf	d0,MClear
MErrorExit:
	move.l	#LoadErrorText,TextAdres
	bsr	Status
MErrorExit2:
	bsr	MCloseLFile
	bra	MergeOk

MergeStart:	dc.l	0
MFullHex:	dc.l	0
MergeBuffer:	blk.b	84,0
even
************************************************************************
*********  SHOW DIRECTORY  ***************
******************************************
ShowDir:
	bsr	DirOpenWindow
	move.l	#DirNameQuestion,d2	;Read
	bsr	WriteWindow		;data name
	bsr	ReadWindow		;From Keyboard
	bsr	CopyDirName

	move.l	DosBase,a6
	move.l	#DName,d1
	move.l	#'R',d2		;read
	jsr	Lock(a6)		;Lock	
	move.l	d0,RLock
	beq	CantFindError

	move.l	RLock,d1
	move.l	#InfoBuffer,d2
	jsr	Examine(a6)	;examine
	tst.l	d0		;error ?
	beq	CantExamineError

	lea	InfoBuffer,a0
	move.l	120(a0),d7	;is this a directory
	bmi	NotDirectoryError

Next:
	move.l	RLock,d1
	move.l	#InfoBuffer,d2
	jsr	ExNext(a6)	;ExNext
	tst.l	d0
	beq	IOError

	lea	InfoBuffer,a0
	lea	8(a0),a0	;point to the name
	move.l	a0,d2
	move.l	#-1,d3		;load the character counter
CLoop:
	tst.b	(a0)+		; end ?
	dbeq	d3,CLoop
	not.l	d3		; lenght
	move.l	InputWindow,d1
	jsr	Write(a6)

	move.l	InputWindow,d1
	move.l	#Return,d2
	move.l	#1,d3
	jsr	Write(a6)

	bra	Next
IOError:
	jsr	OIError(a6)	;IOError
	cmp.l	#232,d0		;is this no more entries
	bne	WrongError
DErrorExit2:	
	move.l	RLock,d1
	jsr	UnLock(a6)		;unlock

DErrorExit:
	move.l	#PressSpace,d2
	bsr	WriteWindow

PressKey:
	move.b	KeyBuffer,d0
	not.b	d0
	lsr.b	#1,d0

	cmp.b	#$40,d0
	bne	PressKey

	bsr	CloseInputWindow
	clr.b	KeyBuffer
	bra	Main
CantFindError:
	move.l	#CantFind,d2
	bsr	WriteWindow
	bra	DErrorExit
CantExamineError:
	move.l	#CantExamine,d2
	bsr	WriteWindow
	bra	DErrorExit2
NotDirectoryError:
	move.l	#NotDirectory,d2
	bsr	WriteWindow
	bra	DErrorExit2
WrongError:
	move.l	#Wrong,d2
	bsr	WriteWindow
	bra	DErrorExit2
DirOpenWindow:
	move.l	DosBase,a6
	move.l	#DirWindowData,d1
	move.l	#1006,d2	;Mode Old File
	jsr	Open(a6)	;Open Window
	move.l	d0,InputWindow
	rts

RLock:	dc.l	0
Return:		dc.b	$a
DirNameQuestion:	dc.b	$0d,$0a,' Directory Name: ',0
DirWindowData:dc.b'CON:150/10/300/240/TST Sorter Directory Window  ',0
PressSpace:	dc.b	$0d,$0a,'     PRESS SPACE TO CONTINUE   ',0
CantFind:	dc.b	$0d,$0a," Can't Find The Directory ...",0
CantExamine:	dc.b	$0d,$0a," Can't Examine The Directory ...",0
NotDirectory:	dc.b	$0d,$0a," This Is Not A Directory ...",0
Wrong:		dc.b	$0d,$0a," Something Went Wrong ...",0,0,0
*****************************************************************
********  PRINT  ***********
****************************
PrintListe:
	cmp.l	#0,FullHex
	beq	PListOk

	move.l	#PrintSQuest,TextAdres
	bsr	Status
GetPrinterKey:
	move.b	KeyBuffer,d0
	not.b	d0
	lsr.b	#1,d0

	cmp.b	#$20,d0		; 'A'
	beq	PrintAll

	cmp.b	#$17,d0		; 'I'
	beq	PrintId

	cmp.b	#$33,d0		; 'C'
	beq	PListOk

	bra	GetPrinterKey

PListOk:
	move.l	#MemOk,TextAdres
	bsr	Status
	clr.b	KeyBuffer
	bra	Main

PrintAll:
	bsr	PGetMaxDataCount

	bsr	POpenWindow
	move.l	#PText,d2
	bsr	WriteWindow
	bsr	PrinterOpen
	move.l	#0,PPNumber
	move.l	#1,PCounter
NextPage:
	move.l	#0,PPNCount
	add.l	#1,PPNumber
	bsr	PLineFeed
	bsr	PTitleWrite

	bsr	PLineFeed
	bsr	PLineFeed

	move.l	#PHead,PStart
	move.l	#62,PLenght
	bsr	PPrint

	bsr	PLineFeed

	move.l	#PHead2,PStart
	move.l	#80,PLenght
	bsr	PPrint

GetPKey:
	bsr	PLineFeed

	move.l	ListStartAdres,a2
	move.l	PCounter,d1
	mulu	#80,d1
	add.l	d1,a2
	move.l	a2,PStart
	move.l	#80,PLenght
	bsr	PPrint


	move.l	FullHex,d1
	add.l	#1,PCounter
	cmp.l	PCounter,d1
	blt	APrintOk

	add.l	#1,PPNCount
	move.l	PagePLenght,d0
	cmp.l	PPNCount,d0
	beq	NextPage1

	move.b	KeyBuffer,d0
	not.b	d0
	lsr.b	#1,d0

	cmp.b	#$33,d0		; 'C'
	bne	GetPKey
APrintOk:
	bsr	PLineFeed
	bsr	PLineFeed
	bsr	PLineFeed
	bsr	PLineFeed
	bsr	PrinterClose
	bsr	CloseInputWindow
	bra	PListOk
NextPage1:
	bsr	PLineFeed
	bra	NextPage
PrintId:
	bsr	PGetMaxDataCount

	bsr	POpenWindow
	move.l	#PText,d2
	bsr	WriteWindow
	bsr	PrinterOpen
	move.l	#0,PPNumber
	move.l	#1,PCounter
INextPage:
	move.l	#0,PPNCount
	add.l	#1,PPNumber
	bsr	PLineFeed
	bsr	PTitleWrite

	bsr	PLineFeed
	bsr	PLineFeed

	move.l	#IHead3,PStart
	move.l	#77,PLenght
	bsr	PPrint

	bsr	PLineFeed

	move.l	#IHead4,PStart
	move.l	#78,PLenght
	bsr	PPrint

IGetPKey:
	bsr	PLineFeed

	move.l	ListStartAdres,a2
	move.l	PCounter,d1
	mulu	#80,d1
	add.l	d1,a2
	move.l	a2,PStart
	move.l	#25,PLenght
	bsr	PPrint

	bsr	PInterDatas

	move.l	FullHex,d1
	add.l	#1,PCounter
	cmp.l	PCounter,d1
	blt	IAPrintOk
	
	move.l	ListStartAdres,a2
	move.l	PCounter,d1
	mulu	#80,d1
	add.l	d1,a2
	move.l	a2,PStart
	move.l	#25,PLenght
	bsr	PPrint

	bsr	PInterDatas

	move.l	FullHex,d1
	add.l	#1,PCounter
	cmp.l	PCounter,d1
	blt	IAPrintOk

	move.l	ListStartAdres,a2
	move.l	PCounter,d1
	mulu	#80,d1
	add.l	d1,a2
	move.l	a2,PStart
	move.l	#26,PLenght
	bsr	PPrint

	move.l	FullHex,d1
	add.l	#1,PCounter
	cmp.l	PCounter,d1
	blt	IAPrintOk

	add.l	#1,PPNCount
	move.l	PagePLenght,d0
	cmp.l	PPNCount,d0
	beq	INextPage1

	move.b	KeyBuffer,d0
	not.b	d0
	lsr.b	#1,d0

	cmp.b	#$33,d0		; 'C'
	bne	IGetPKey
IAPrintOk:
	bsr	PLineFeed
	bsr	PLineFeed
	bsr	PLineFeed
	bsr	PLineFeed
	bsr	PrinterClose
	bsr	CloseInputWindow
	bra	PListOk
INextPage1:
	bsr	PLineFeed
	bra	INextPage
PrinterOpen:
	move.l	DosBase,a6
	move.l	#PrtName,d1
	move.l	#1006,d2
	jsr	Open(a6)
	move.l	d0,PrtHandle
	rts
PrinterClose:
	move.l	DosBase,a6
	move.l	PrtHandle,d1
	jsr	Close(a6)
	rts
POpenWindow:
	move.l	DosBase,a6
	move.l	#PrintWindow,d1
	move.l	#1006,d2	;Mode Old File
	jsr	Open(a6)	;Open Window
	move.l	d0,InputWindow
	rts
PTitleWrite:
	move.l	ListStartAdres,a2
	lea	20(a2),a2
	move.l	a2,PStart
	move.l	#60,PLenght
	bsr	PPrint

	lea	PPNumber,a0
	bsr	HexToDEc
	move.l	Buffer,PageN
	move.l	#Page,PStart
	move.l	#16,PLenght
	bsr	PPrint

	rts
PPRint:
	move.l	Dosbase,a6
	move.l	PrtHandle,d1
	move.l	PStart,d2
	move.l	PLenght,d3
	jsr	Write(a6)
	rts
PLineFeed:
	move.l	DosBase,a6
	move.l	PrtHandle,d1
	move.l	#LF,d2
	move.l	#1,d3
	jsr	Write(a6)
	rts
PInterDatas:
	move.l	DosBase,a6
	move.l	PrtHandle,d1
	move.l	#IC,d2
	move.l	#1,d3
	jsr	Write(a6)
	rts
PGetMaxDataCount:
	bsr	OpenInputWindow

	move.l	#PDataQuestion,d2	;Read
	bsr	WriteWindow		;Maximum DataNumber
	bsr	ReadWindow		;From Keyboard
	bsr	CloseInputWindow

	move.l	#3,d0
	lea	Input,a0
	lea	PagePLEnght,a1
PDigitControl:
	move.b	(a0)+,d1

	cmp.b	#$2f,d1
	bls	PGreatNumber
	cmp.b	#$3a,d1
	bge	PGreatNumber

	move.b	d1,(a1)+
	dbf	d0,PDigitControl

	cmp.b	#$0a,(a0)+	;RETURN
	bne	PGreatNumber

	clr.l	d0
	clr.l	d1
	move.l	#PagePLenght,d2
	move.l	#4,d3
	bsr	ASCIIDecToHex
	move.l	d0,PagePLenght
	rts

PGreatNumber:
	move.l	#NumberError,TextAdres
	bsr	Status	
	bra	PGetMaxDataCount	

PagePLenght:	dc.l	0
PPNCount:	dc.l	0
PPNumber:	dc.l	0
PCounter:	dc.l	0
PLenght:	dc.l	0
PStart:		dc.l	0
PrtHandle:	dc.l	0
PrtName:	dc.b	'PRT:',0
LF:	dc.b	$0a
PCR:	dc.b	$0d
IC:	dc.b	124
PrintWindow:
	dc.b	'CON:150/80/250/75/TST Sorter Print Window ',0
even
PText:	dc.b	$0d,$0a,$0d,$0a,'         PRINTING......'
	dc.b	$0d,$0a,$0d,$0a,'     Press (C) to CANCEL'
	dc.b	$0d,$0a,$0d,$0a,'            ',0
even
PrintSQuest:	dc.b	'Print (A)ll or (I)d & Names only or (C)ancel'
		dc.b	'            '
even
PHead:	dc.b	'NAME                ID    LENGHT DATE     '
	dc.b	'KICK MEMORY EXPLAIN  ' 
even
PHead2:	dc.b	'------------------- ----- ------ -------- '
	dc.b	'---- ------ --------------------------'
even
IHead3:	dc.b	'NAME                ID    '
	dc.b	'NAME                ID    '
	dc.b	'NAME                ID   '
even
IHead4:	dc.b	'------------------- ----- '
	dc.b	'------------------- ----- '
	dc.b	'------------------- -----'
even
Page:	dc.b	'    PAGE    '
PageN:	dc.b	'    '
even
PDataQuestion:	dc.b	$0d,$0a,$0d,$0a,$09,'Enter Page Lenght'
		dc.b	' (0000) format: ',0,0,0
even
InfoBuffer:	blk.b	400,0