;------------------------------------------------------------------------
;		Copyright 2010 Integrated Logic Systems
;                  Source Code is Copyright Stephen J. Carden
;
;
;			Please do not share this source!
;------------------------------------------------------------------------
;                              Poke.com
;
;	This is a program to poke a byte and display it to the screen
;		init	3/08/2010	sjc new design
;		revisited 4/26/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,"Poke.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   26
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; 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
pokeabyte:
			lda	portb				; Reading the byte from $d301 for later use
			sta	under.the.os.data		; Storing it away for later

								; 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	poke.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	.showhelp			; going to the help menu
			cmp	#'$'				; see if we are going to use Hex
			beq	.gothex
			cmp	#'?'
			beq	.tellfilehistory
			cmp	#' '
			beq	.oknum
			cmp	#$9b
			beq	.badparms
			sta	mynumberstring,x
			cmp	#'0'     			; let'S see if it is between o and 9
			bcc	.oknum 				; less than 1
			cmp	#'9'+1
			bcs	.badparms			; greater than 9
			inx
			iny
			jmp	.af
.showhelp:		jmp	go_show_help

.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	.badparms			; gota add error here
			cmp	#' '				; ok go a second parm
			beq	.got.second.parm

			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	.badparms			; yes, we got a bad char
.charok:		inx
.badchar:		iny
			jmp	.h

.badparms:		jmp	noparmerror

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

			ldx	#$00
			iny
.h.h:			lda	(comtab),y			; well got a byte
			jsr	upcase
			sta	my.poke.byte,x			; save the byte to a buffer

			cmp	#'$'
			beq	.byte.in.hex
			cmp	#'''
			beq	.gotascii
			cmp	#$9b
			beq	.real.eol
			cmp	#$20				; looking for a space
			beq	.got.more.here
			cmp	#'0'
			bcc	.me.badchar
			cmp	#'9'+1
			bcc	.me.char.ok
			cmp	#'A'
			bcc	.me.badchar
			cmp	#'F'+1
			bcs	.me.badchar

.me.char.ok:		inx
.me.badchar:		iny
			jmp	.h.h

.byte.in.hex:		lda	#$01
			sta	byteinhex
			iny
			jmp	.h.h				; 


.gotascii:		iny
			lda	(comtab),y			; well got a byte
			sta	hold_the_byte_forlater
			lda	#$02
			sta	byteinhex
			jmp	.h.h				;

.got.more.here:		iny					; see if there is another char
			lda	(comtab),y			; from the command line
			cmp	#'/'				; is it a "/" switch
			bne	.real.eol			; nope.. we done
			cmp	#$9b				; is it the return key
			beq	.real.eol			; 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	.real.eol			; 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


.real.eol:		inx
			lda	#$9b
			sta	my.poke.byte,x

			jsr	convert_to_byte			; Gota convert stuff to hex so we can poke bytes
			sta	hold_the_byte_forlater

.donewithcli:		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




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


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			; OS reference Byte
			cmp	#$00				; see what we are doing
			beq	.not_under			; Yeap!  We are going under the os
			jsr	os_off				; Turn off the os
.not_under:

			lda	hold_the_byte_forlater
location_byte:		sta	$ffff				; read the memory location into the accumlator


			jsr	wait_vbi
			jsr	wait_vbi


			lda	under.the.os			; OS reference Byte
			cmp	#$00				; see what we are doing
			beq	.not_under			; Yeap!  We are going under the os
			jsr	os_on				; YEs we need to turn on the OS
.not_under:
			lda	hold_the_byte_forlater
			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 					; just a place holder for right now
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;  Now this routeen does all the Hex converion and prints it 
; to the screen
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

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:
			lda	hold_the_byte_forlater
.location_byte:		sta	$ffff				; now we have our poke byte 
			sta	tammy.byte

			jsr	wait_vbi
			jsr	wait_vbi

			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
			rts 					; Time to exit the program





;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;this tells me what mode to be in decimal or hex
;
inhexmode:		dc.b	0

byteinhex:		dc.b	0

hold_the_byte_forlater:	dc.b	0
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;this the the location of the byte we are going to read.
;
source_location:	dc.w	0
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;OS reference bytes
under.the.os:		dc.b	0
under.the.os.data:	dc.b	0
tammy.byte:		dc.b	0

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Aborted the program with a consol key
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
poke.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>,"|     Poke 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	"       Poke  [Parm1] [Parm2] [Parm3]",$9b
			dc.b	"       Poke $(0-ffff) $(00-ff)",$9b
			dc.b	"       Poke (0-65535) (0-255)",$9b
			dc.b	"       Poke $(0-ffff) '(ascii Byte)",$9b
			dc.b	"       Poke (0-65535) '(ascii Byte)",$9b
			dc.b	"       Parm3 = '/U' under the OS",$9b
			dc.b	$9b
			dc.b	" Poke $E000 $01 /U",$9b

			dc.b	$9b,$9b,$9b
			dc.b	-1
			rts
;
;---------------------------------------------------
;
;
;---------------------------------------------------
convert_to_byte:
			lda	byteinhex
			cmp	#$01
			beq	.byteinhex
			cmp	#$02
			beq	.got.ascii
			jsr	get_numbercli
			rts

.byteinhex:
			jsr	do.hex.conversion.byte
			lda	expr_1
			rts
.got.ascii:
			lda	hold_the_byte_forlater

			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

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

get_numbercli:
                	mea     my.poke.byte,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

my.poke.byte:		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
;----------------------------------------------------------
;
;Get ascii hex bytes and turn them into a byte.
;
;----------------------------------------------------------
do.hex.conversion.byte:
			ldy	#0
			lda	#0
			sta	expr_1
			sta	expr_1+1

.hexin1:		jsr	getitbyte
			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_1
			rol	expr_1+1
			dex
			bne	.hexin3
			iny
			bne	.hexin1
.hexrts:		lda	expr_1
			ldx	expr_1+1
			rts


expr_1:			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
;
;----------------------------------------------------------
;
;this is a way that acts like the screen editor and reads 
;one byte at a time.
;
;
;----------------------------------------------------------

getitbyte:
			sty	.axy+2
			stx	.axy+1
			ldy	.temp			
			lda	my.poke.byte,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
;
;-----------------------------
;wait for a vbi to happen
;-----------------------------
wait_vbi:		lda	$14
.w1:			cmp	$14
			beq	.w1
			rts

;-----------------------------
;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	$b0
			pla
			sta	$b1
			ldy	#$01
.a:			lda	($b0),y
			cmp	#$ff
			beq	.b
			jsr	sprint
			jsr	.c
			jmp	.a
.b:			jsr	.c
			lda	$b1
			pha
			lda	$b0
			pha
			rts
.c:			inc	$b0
			bne	.d
			inc	$b1
.d:			rts
;
;
;------------
; 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
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;Turn the os on or off
;
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
