;------------------------------------------------------------------------
;		Copyright 2010 Integrated Logic Systems
;                  Source Code is Copyright Stephen J. Carden
;
;
;			Please do not share this source!
;------------------------------------------------------------------------
;                              Peek.com
;
;	This is a program to peak a byte and display it to the screen
;		init	2/24/2010	sjc new design
;		added hex delimeter 		2/25/2010	sjc		
;		added new code for registered user 2/26/2010	sjc
;
;Updated the screen Print Utility so it will work with the exp-80
; This change will also help "Print P:"		8/17/2012	sjc
;
;
;Also added code for Control+1 pause of screen to the high speed screen
;handling.		8/24/2012	sjc
; 
;
;
;
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;------------------------------------------------------------------------
; Notes: o This source code MAY NOT be placed for download on any BBS's!
;        o "mea" is a macro that loads the address of the first field
;          into the pointer specified by the second field.
;------------------------------------------------------------------------
; Assembler:  MADMAC (tm) ST Cross Assembler (Atari Corp)
;             XASM   st and IBM VERSIONS
;------------------------------------------------------------------------

com_file_name:		.macro
;			dc.b   13,"filename.ext",$9b
			dc.b   12,"Peek.com    ",$9b
			.endm

;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; File revision history. Version Number in hex
;
file_ver:		equ   $16
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the Month in dec for the first time this revision 
;was compiled
;
c_month:		equ   8
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the day in dec for the first time this revision 
;was compiled
c_day:			equ   24
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the year in dec for the first time this revision 
;was compiled
c_year:			equ   2012
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Type of compiler used in program
;
; 0 = unknown Compiler
; 1 = xasm
; 2 = mac_65
; 3 = basic
; 4 = compiled basic xl
; 5 = C65
; 6 = Action
;
; We can add more as time goes on!
;
;
;
xasm:			equ	1
mac_65:			equ	2 
basic:			equ	3
basicxl:		equ	4
c65:			equ	5
action:			equ	6

file_compiler:		equ	xasm
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; is this relocatable code ?
; anyother value other than 1 or 2 would be unknown
r..yes:			equ	1
r..no:			equ	2
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Gotta define if it can be relocated
l_relocatable:		equ	r..no
;
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Gotta define our Header control Byte
;$ff =bypass intro
;$15 = Bypass Dos check
r..crl:			equ	$7d
r..crlf:		equ	$9b
r..space:		equ	$20
r..bypassDOS:		equ	$15
r..bypass:		equ	$ff

l_frstscreenbyte:	equ	r..space
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; The language the output file is in. 
;
;
; 0	=	Undifined
; 1	=	English
; 2	=	German
;
r..language:		equ	1
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


			.include	equates
			.include	globals
			.include	macros

			.org  $4000

win_start:
header_info:
			.include	header			; this reads info out of the header and displays to screen
;								; based on info stored at the front of the file
peekabyte:
			lda	portb
			sta	under.the.os.data
								; let'S see if anything is on the parm line
			ldy	#LBUF    			; loading the offset into comtab
.a:			lda	(comtab),y
			cmp	#' '				; looking for the space in the parm line
			beq	.gotspacechar 			; got the space let'S see if there is anything we can use
			cmp	#$9b				; nope!!  no parm
			beq	.noparmerror 			; let'S see if they are playing with the consol

			iny
			lda	#consol_start			; gonna look for the Start key
			cmp	consol				; comparing to the consol key
			beq	.tellfilehistory		; got the start key now lets print all the compiling info
			lda	#consol_any			; any consol key
			cmp	consol				; CONSOL KEY
			bne	.abort				; YEP!!!  abort screen
			jmp	.a

.noparmerror:		jmp	noparmerror
.tellfilehistory:	jmp	my_file_notice
.abort:			jmp	peek.a.byte.abort


.gotspacechar:
			ldx	#$00
			iny					; let'S get one more byte of contab+63,y

.af:			lda	(comtab),y			; well got a byte
			jsr	upcase 				; let'S make sure it is upper case
			cmp	#'H'
			beq	.go_show_help			; going to the help menu
			cmp	#'$'				; see if we are going to use Hex
			beq	.gothex
			cmp	#'?'
			beq	.tellfilehistory
			cmp	#$9b
			beq	.oknum
			sta	mynumberstring,x
			cmp	#'0'     			; let'S see if it is between o and 9
			bcc	.oknum 				; less than 1
			cmp	#'9'+1
			bcs	.oknum				; greater than 9
			inx
			iny
			jmp	.af

.go_show_help:		jmp	peek.a.byte.abort		; help menu

.gothex:		iny
			lda	#$80
			sta	inhexmode
.h:			lda	(comtab),y			; well got a byte
			jsr	upcase 				; let'S make sure it is upper case
			sta	mynumberstring,x		; save the byte to a buffer
			cmp	#$9b				; is it end of line
			beq	.eol				; yes
			cmp	#$20				; lets see if there is another space
			beq	.got.more.here			; yeap!  got more here
			cmp	#'0'				; is it an ascii char less that '0'
			bcc	.badchar			; not a hex char
			cmp	#'9'+1				; is 0 to 9 hex char
			bcc	.charok				; yes 
			cmp	#'A'				; is it less that A
			bcc	.badchar			; yes bad hex byte
			cmp	#'F'+1				; is it greater than F
			bcs	.oknum				; yes, and we got everything off the cli
.charok:		inx
.badchar:		iny
			jmp	.h

.got.more.here:		iny					; see if there is another char
			lda	(comtab),y			; from the command line
			cmp	#'/'				; is it a "/" switch
			bne	.oknum				; nope.. we done
			cmp	#$9b				; is it the return key
			beq	.oknum				; yes we are done. with the cli
			iny					; get another key of the cli
			lda	(comtab),y			; this is the command line
			cmp	#'U'				; is it a 'U'
			bne	.oknum				; nope we are done with the cli
			lda	#$01				; it was a "U" so we are gonna turn of the OS
			sta	under.the.os			; reference byte

.oknum:
			inx
.eol:			lda	#$9b
.goodhexeol:		sta	mynumberstring,x


			lda	inhexmode
			cmp	#$00
			beq	indecmode
			jsr	dohexconversion
			ldx	expr+1
			lda	expr
			sta	source_location			; let's change the drive number in the bat string
			stx	source_location+1

			jmp	hex_screen_print



indecmode:
			jsr	get_number_cli
			sta	source_location			; save our memory location we are going to read
			stx	source_location+1

dec_screen_print:
			jsr	printsi
			dc.b	$9b," Location ",-1
			lda	source_location			; load our memory location we are readling
			ldx	source_location+1
			jsr	pr_card				; Display in decmial to the screen

			jsr	printsi
			dc.b	" =",-1

			lda	source_location			; punching our memory location into a section to read it
			sta	location_byte+1
			lda	source_location+1
			sta	location_byte+2

			lda	source_location			; punching our memory location into a section to read it
			sta	location_byte2+1
			lda	source_location+1
			sta	location_byte2+2

			lda	under.the.os
			cmp	#$00
			beq	.not_under
			jsr	os_off
.not_under:

location_byte:		lda	$ffff				; read the memory location into the accumlator
			sta	tammy.byte

			lda	under.the.os
			cmp	#$00
			beq	.not_under
			jsr	os_on
.not_under:
			lda	tammy.byte

			jsr	pr_byte				; print in in dec
			jsr	printsi				; screen display stuff
			dc.b	"   '",-1			;

			lda	under.the.os
			cmp	#$00
			beq	..not_under
			jsr	os_off
..not_under:



location_byte2:		lda	$ffff				; read the memory location into the accumlator
			sta	tammy.byte

			lda	under.the.os
			cmp	#$00
			beq	.not_under
			jsr	os_on
.not_under:
			lda	tammy.byte
			jsr	echo				; print it in Atascii
			jsr	printsi				; more screen printing
			dc.b	"'"
			dc.b	$9b,$9b,$9b,-1

			rts 					; time to exit


hex_screen_print:

			jsr	printsi
			dc.b	$9b," Location $",-1
			lda	source_location			; loading up the a/x to print a card to the screen
			ldx	source_location+1
			jsr	pr_hex_card			; print a card to the screen

			jsr	printsi
			dc.b	" =$",-1

			lda	source_location			; gotta love self modifying code
			sta	.location_byte+1
			lda	source_location+1
			sta	.location_byte+2

			lda	source_location			; gotta love self modifying code
			sta	.location_byte2+1
			lda	source_location+1
			sta	.location_byte2+2

			lda	under.the.os
			cmp	#$00
			beq	.not_under
			jsr	os_off
.not_under:

.location_byte:		lda	$ffff				; now we have our peek byte 
			sta	tammy.byte

			lda	under.the.os
			cmp	#$00
			beq	.n_under
			jsr	os_on
.n_under:
			lda	tammy.byte
			jsr	pr_hex_byte			; print the dec to the screen
			jsr	printsi
			dc.b	"   '",-1
			lda	under.the.os
			cmp	#$00
			beq	.location_byte2
			jsr	os_off

.location_byte2:	lda	$ffff				; now have the atascii byte
			sta	tammy.byte

			lda	under.the.os
			cmp	#$00
			beq	.tn_under
			jsr	os_on
.tn_under:
			lda	tammy.byte


			jsr	echo				; print thr atascii byte to the screen
			jsr	printsi
			dc.b	"'"
			dc.b	$9b,$9b,$9b,-1

			jsr	os_on

			rts 					; Time to exit the program
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;this tells me what mode to be in decimal or hex
;
inhexmode:		dc.b	0
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;OS reference bytes
under.the.os:		dc.b	0
under.the.os.data:	dc.b	0
tammy.byte:		dc.b	0

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;this the the location of the byte we are going to read.
;
source_location:	dc.w	0
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Aborted the program with a consol key
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
peek.a.byte.abort:
			jsr	bell				; Ooop'S they aborted the file
			jsr	printsi
			dc.b	$9b,$9b
			dc.b	" "
			dc.b	<+128>,""
			dc.b	$9B
			dc.b	" "
			dc.b	<+128>,"|     Peek a byte in Memory      |"
			dc.b	$9B
			dc.b	" "
			dc.b	<+128>,"| Written by: Stephen J. Carden  |"
			dc.b	$9B
			dc.b	" "
			dc.b	<+128>,""
			dc.b	$9B,$9B,$FF
			rts
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Well they did not pass the parms the program requires
; so now they get the syntax error message
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
noparmerror:
			JSR	printsi
			dc.b	$9b,$9b
			dc.b	"Syntax:"
			dc.b	<+128>,"Error"
			dc.b	$9b
			dc.b	"Usage:"
			dc.b	$9b
			dc.b	"       Peek  [Parm1] [Parm2]",$9b
			dc.b	"       Peek $(0-ffff)",$9b
			dc.b	"       Peek (0-65535)",$9b
			dc.b	"       Peek [Parm1] /U",$9b
			dc.b	"       /U= Turn Off the OS",$9b
			dc.b	$FF
			rts

;
;       gets a CARD value - returned in A/X
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

get_number_cli:
                	mea     mynumberstring,inbuff
                	lda     #0			;1
                	sta     cix
                	jsr     afp                     ;ascii --> floating pt.
                	bcs     .default
                	jsr     fpi                     ;floating --> integer
                	bcs     .default
                	lda     fr0
                	ldx     fr0+1
                	rts
.default:       	lda     #0
                	tax
                	rts

.work:          	ds.b    255

mynumberstring:		ds.b	255
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;Prints a byte or a card to the screen
;
;
pr_byte:
			ldx	#$00
pr_card:
			sta	fr0
			stx	fr0+1
			lda	#$00
			sta	cix
			jsr	ifp
			jsr	fasc
			ldy	#$00
.aprbloop:
			lda	(inbuff),y
			php
			and	#$7f
			iny
			jsr	echo
			plp
			bpl	.aprbloop
			rts

;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;   this routeen make the hex number's and places into a hex string
;  low byte in s_ptr high pointer in s_ptr+1
;

h_card:			sta	.h_cardd
			lda	s_ptr
			sta	.a3+1
			lda	s_ptr+1
			sta	.a3+2
			txa
			ldy	#$00
			jsr	.rive_error
			lda	.h_cardd
			jsr	.rive_error
			rts

.h_cardd:		dc.b	0

.rive_error:		pha
			lsr
			lsr
			lsr
			lsr
			jsr	.a1
			pla
			and	#$0f
.a1:			cmp	#$0a
			bcs	.a2
			ora	#$30
			bne	.a3
.a2:			adc	#$36
.a3:			sta	$ffff,y
			iny
			rts
;-----------------------------
; Print Hex Numbers to screen byte or card
;-----------------------------
;
;
; print a hex word value
; low byte in a reg x is high byte
;
pr_hex_card:		sta	.h_cardd
			txa
			jsr	pr_hex_byte
			lda	.h_cardd
			jsr	pr_hex_byte
			rts
;
.h_cardd:		dc.b	$00
;
pr_hex_byte:		pha
			lsr
			lsr
			lsr
			lsr
			jsr	.a
			pla
			and	#$0f
.a:			cmp	#$0a
			bcs	.b
			ora	#$30
			bne	.c
.b:			adc	#$36
.c:			jsr	echo
			rts

;----------------------------------------------------------
;
;Get ascii hex bytes and turn them into a word.
;
;----------------------------------------------------------
dohexconversion:
			ldy	#0
			lda	#0
			sta	expr
			sta	expr+1

.hexin1:		jsr	getitnow
			cmp	#'0'
			bcc	.hexrts


			cmp	#'9'+1
			bcc	.hexin2
			cmp	#'A'
			bcc	.hexin2
			cmp	#'F'+1
			bcs	.hexrts
			sbc	#6
.hexin2:		and	#$0F
			ldx	#4
			asl
			asl
			asl
			asl
.hexin3:		asl
			rol	expr
			rol	expr+1
			dex
			bne	.hexin3
			iny
			bne	.hexin1
.hexrts:		lda	expr
			ldx	expr+1
			rts


expr:			dc.w	0

;----------------------------------------------------------
;
;this is a way that acts like the screen editor and reads 
;one byte at a time.
;
;
;----------------------------------------------------------

getitnow:
			sty	.axy+2
			stx	.axy+1
			ldy	.temp			
			lda	mynumberstring,y
			sta	.axy
			iny
			sty	.temp
			lda	.axy
			ldx	.axy+1
			ldy	.axy+2

			rts

.temp:			dc.b	0
.axy:			dc.b	0,0,0
;

;-----------------------------
;CHANGES THE CHARTER TO UPCASE
;-----------------------------
upcase
			cmp	#$61
			bcc	.a
			cmp	#$7a
			bcs	.a
			sbc	#$1f
.a:			rts

;
;---------------------------
;this one make's a nice tone
;---------------------------
bell
			sta	.data
			sty	.data+1
			stx	.data+2
			ldy	#$af
			lda	#$14
			sta	$d200
.a:			sty	$d201
			lda	#$00
			sta	$14
.b:			lda	$14
			cmp	#$02
			bcc	.b
			dey
			cpy	#$a0
			bcs	.a
			lda	.data
			ldy	.data+1
			ldx	.data+2
			rts
.data:			dc.b	$00,$00,$00
;
;
;
;--------------------------------------------
;printsi Routeen macro             
;this is a slow print to the screen
;usage jsr	printsi
;    .byte $9b," string to be printed",$ff
;--------------------------------------------
;
printsi:
			pla
			sta	.pstr+1
			pla
			sta	.pstr+2
.prsl:			inc	.pstr+1
			bne	.pstr
			inc	.pstr+2
.pstr:			lda	$ffff
			cmp	#$ff
			beq	.estri
			jsr	fast_output
			jmp	.prsl
.estri:			lda	.pstr+2
			pha
			lda	.pstr+1
			pha
			rts
;
;	

;
;-------------------------
;actual screen handler    
;screen offset definitions
;-------------------------
scr_offset:
			dc.w	0
			dc.w	40
			dc.w	80
			dc.w	120
			dc.w	160
			dc.w	200
			dc.w	240
			dc.w	280
			dc.w	320
			dc.w	360
			dc.w	400
			dc.w	440
			dc.w	480
			dc.w	520
			dc.w	560
			dc.w	600
			dc.w	640
			dc.w	680
			dc.w	720
			dc.w	760
			dc.w	800
			dc.w	840
			dc.w	880
			dc.w	920
;
echo:
fast_output:
			sta	$5a
			lda	sc.redirect
			cmp	#print_p
			beq	.go_cio
.leo:
			lda 	$02ff   	; CONTROL 1 FLAG
			cmp 	#$00
			bne 	.leo

			lda	$5a
			cmp	#32
			bcc	.do_look
			cmp	#125
			bcc	.do_here
.do_look:		ldy	#0
.lookup:		lda	.char_table,y
			beq	.do_here
			cmp	$5a
			beq	.go_cio
			iny
			bne	.lookup


.go_cio:		lda	$5a
			jmp	putlocal


.do_here:		ldy	#0
			lda	$5d
			sta	($5e),y
			lda	$5a
			cmp	#$9b
			beq	.docr
.notcr:			jsr	.get_adr
			lda	$5a
			and	#$7f
			cmp	#32
			bcc	.add64
			cmp	#96
			bcc	.sub32
			jmp	.asis
.add64:			clc
			adc	#64
			jmp	.asis
.sub32:			sec
			sbc	#32
.asis:			bit	$5a
			bpl	.xxlate
			ora	#$80
.xxlate:		ldy	#0
			sta	($5e),y
			inc	$55
			inc	$63
			lda	$55
			cmp	#40
			bcs	.next_row
			iny
			lda	($5e),y
			sta	$5d
			ora	#$80
			ldx	752
			bne	.nocurs1
			sta	($5e),y
.nocurs1:		inc	$5e
			bne	.nooav
			inc	$5e+1
.nooav:			rts
.docr:			lda	#0
			sta	$63
.next_row:		lda	$52
			sta	$55
			inc	$54
			ldy	$54
			cpy	#24
			bcs	.scroll
			jsr	.get_adr
			ldy	#0
			lda	($5e),y
			sta	$5d
			ldx	752
			bne	.nocurs2
			ora	#$80
			sta	($5e),y
.nocurs2:		rts

.scroll:		dec	$54
			lda	$58
			sta	$68
			clc
			adc	#40
			sta	$5e
			lda	$58+1
			sta	$68+1
			adc	#0
			sta	$5e+1
			ldy	#0
			ldx	#3
.scloop:		lda	($5e),y
			sta	($68),y
			iny
			bne	.scloop
			inc	$5e+1
			inc	$68+1
			dex
			bne	.scloop
.scloop2:		lda	($5e),y
			sta	($68),y
			iny
			cpy	#152
			bcc	.scloop2
			lda	$58
			clc
			adc	#920&$ff
			sta	$5e
			lda	$58+1
			adc	#920/256
			sta	$5e+1
			ldy	#0
			tya
.clear:			sta	($5e),y
			iny
			cpy	#40
			bcc	.clear
			ldx	752
			bne	.nocurs3
			lda	#$80
			ldy	$55
			sta	($5e),y
.nocurs3:		lda	#0
			sta	$5d
			lda	$5e
			clc
			adc	$55
			sta	$5e
			lda	$5e+1
			adc	#0
			sta	$5e+1
			rts
.get_adr:		lda	$54
			asl
			tay
			lda	$58
			clc
			adc	scr_offset,y
			sta	$5e
			lda	$58+1
			adc	scr_offset+1,y
			sta	$5e+1
			lda	$5e
			clc
			adc	$55
			sta	$5e
			lda	$5e+1
			adc	#0
			sta	$5e+1
			rts
.char_table:
			dc.b	27,28,29,30,31,125,126,127
			dc.b	156,157,158,159,253,254,255,0


putlocal:		ldx	#11
			stx	$0342
			ldx	#0
			stx	$0348
			stx	$0349
			jmp	$e456
;

;
;------------
; PRINT BYTE 
;------------
;echo:
sprint:
			sta	$b8
			lda	#$04
			sta	$034a
			stx	$b6
			sty	$b7
			ldx	#$06
			lda	$e400+1,x
			sta	$b3
			lda	$e400,x
			sta	$b2
			lda	$b8
			jsr	.a
			ldx	$b6
			ldy	$b7
			lda	#$0c
			sta	$034a
			lda	$b8
			rts
;
.a:			inc	$b2
			jmp	($b2)
			rts

;------------------------------
;   GET KEY  ROUTEEN           
;this routeen get's one key and
;return it to the accumlator   
;------------------------------
;
getkey:			stx	$b6
			sty	$b7
			jsr	.a
			ldx	$b6
			ldy	$b7
			rts
.a:			lda	$e420+5
			pha
			lda	$e420+4
			pha
			rts
;
os_on:
			lda	under.the.os.data
			sta	portb
			rts
;
os_off:
			lda	portb
			sta	under.the.os.data
			and	#$fe
			sta	portb
			rts


;--------------
;  help menu section
;--------------
my_file_notice:
			.include	notice

			rts


win_end:
			ds.b	0
