Custom string routines for use with my non-standard variant of Windows 1252

calc1252stringroutines.asm

; This has some custom string routines for use with my non-standard variant of
; Windows 1252.

	.assume adl=1
	.def _strupper
	.def _strlower
	.def _isgreek
if defined GREEK_CASE_CHANGABLE
	.def _disable_greek_case_change
	.def _enable_greek_case_change
end if


;-------------------------------------------------------------------------------
_strupper:
; Converts a string to all uppercase.
; Arguments:
;  - arg0: Pointer to string
; Returns:
;  - Nothing
	pop	de
	pop	hl
	push	hl
	push	de
	ld	hl, .data
	ld	bc, 0
.loop:
	ld	a, (de)
	or	a, a
	ret	z
	ld	c, a
	add	hl, bc
	ld	a, (hl)
	sbc	hl, bc
	ld	(de), a
	inc	de
	jr	.loop
.data:
	db	$00, $01, $02, $03, $04, $05, $06, $06, $08, $09, $09, $0B, $0C, $0D, $0E, $0F
	db	$10, $11, $12, $13, $14, $15, $16, $17, $18, $19, $1A, $1B, $1C, $1D, $1E, $1F
	db	' ', '!', '\"', '#', '$', '%', '&', '\'', '(', ')', '*', '+', ',', '-', '.', '/'
	db	'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', ':', ';', '<', '=', '>', '?'
	db	'@', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O'
	db	'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', '[', '\\', ']', '^', '_'
	db	'`', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O'
	db	'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', '{', '|', '}', '~', $7F
	db	$80
.nogreek:
	db	     $81, $82, $83, $84, $85, $86, $87, $88, $89, $8A, $8B, $8C, $8D, $8E, $8F
	db	$90, $91, $92, $93, $94, $95, $96, $97, $98, $99, $8A, $9B, $8C, $9D, $8E, $9F
	db	$A0, $A1, $A2, $A3, $A4, $A5, $A6, $A7, $A8, $A9, $AA, $AB, $AC, $AD, $AE, $AF
	db	$B0, $B1, $B2, $B3, $B4, $B5, $B6, $B7, $B8
	db	                                             $B9, $BA, $BB, $BC, $BD, $BE, $BF
	db	$C0, $C1, $C2, $C3, $C4, $C5, $C6, $C7, $C8, $C9, $CA, $CB, $CC, $CD, $CE, $CF
	db	$D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7, $D8, $D9, $DA, $DB, $DC, $DD, $DE, $DF
	db	$C0, $C1, $C2, $C3, $C4, $C5, $C6, $C7, $C8, $C9, $CA, $CB, $CC, $CD, $CE, $CF
	db	$D0, $D1, $D2, $D3, $D4, $D5, $D6, $F7, $D8, $D9, $DA, $DB, $DC, $DD, $DE, $9F
if defined GREEK_CASE_CHANGABLE
.greek:
	db	     $90, $82, 'E', $84, 'A', $86, $87, $88, $89, $8A, $8B, $8C, $8D, $8E, $8F
	db	$90, $91, $92, $93, $94, $95, $96, $97, $98, $99, $8A, $9B, $8C, $8D, $8E, $9F
	db	$A0, $A1, $A2, $A3, $A4, $A5, $A5, $A7, $A8, 'H', $AA, $AB, $AC, $AD, $AE, $AE
	db	$B0, $B1, $B2, $B3, $B4, 'M', $B6, $B7, $A8
.greek_end:
_strupper.greek_len := _strupper.greek_end - _strupper.greek
end if


;-------------------------------------------------------------------------------
_strlower:
; Converts a string to all lower-case.
; Arguments:
;  - arg0: Pointer to string
; Returns:
;  - Nothing
	pop	de
	pop	hl
	push	hl
	push	de
	ld	hl, .data
	ld	bc, 0
.loop:
	ld	a, (de)
	or	a, a
	ret	z
	ld	c, a
	add	hl, bc
	ld	a, (hl)
	sbc	hl, bc
	ld	(de), a
	inc	de
	jr	.loop
.data:
	db	$00, $01, $02, $03, $04, $05, $07, $07, $08, $0A, $0A, $0B, $0C, $0D, $0E, $0F
	db	$10, $11, $12, $13, $14, $15, $16, $17, $18, $19, $1A, $1B, $1C, $1D, $1E, $1F
	db	' ', '!', '\"', '#', '$', '%', '&', '\'', '(', ')', '*', '+', ',', '-', '.', '/'
	db	'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', ':', ';', '<', '=', '>', '?'
	db	'@', 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o'
	db	'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', '[', '\\', ']', '^', '_'
	db	'`', 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o'
	db	'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', '{', '|', '}', '~', $7F
	db	$80, $81, $82, $83, $84, $85, $86, $87, $88, $89, $8A, $8B, $9C
.nogreek:
	db                                                                      $8D, $9E, $8F
	db	$90, $91, $92, $93, $94, $95, $96, $97, $98, $99, $8A, $9B, $9C, $9D, $9E, $FF
	db	$A0, $A1, $A2, $A3, $A4, $A5, $A6, $A7, $A8, $A9, $AA, $AB, $AC, $AD, $AE, $AF
	db	$B0, $B1, $B2, $B3, $B4, $B5, $B6, $B7, $B8, $B9, $BA, $BB, $BC, $BD, $BE, $BF
	db	$E0, $E1, $E2, $E3, $E4, $E5, $E6, $E7, $E8, $E9, $EA, $EB, $EC, $ED, $EE, $EF
	db	$F0, $F1, $F2, $F3, $F4, $F5, $F6, $D7, $F8, $F9, $FA, $FB, $FC, $FD, $FE, $DF
	db	$E0, $E1, $E2, $E3, $E4, $E5, $E6, $E7, $E8, $E9, $EA, $EB, $EC, $ED, $EE, $EF
	db	$F0, $F1, $F2, $F3, $F4, $F5, $F6, $F7, $F8, $F9, $FA, $FB, $FC, $FD, $FE, $FF
if defined GREEK_CASE_CHANGABLE
.greek:
	db	                                                                 $9D, $9E, $8F
	db	$81, $91, $92, $93, $94, $95, $96, $97, $98, $99, $8A, $9B, $9C, $9D, $9E, $FF
	db	$A0, $A1, $A2, $A3, $A4, $A6, $A6, $A7, $B8, $A9, $AA, $AB, $AC, $AD, $AF
.greek_end:
_strlower.greek_len := _strlower.greek_end - _strlower.greek
end if


;-------------------------------------------------------------------------------
_isgreek:
; Tests whether a given character is a special Greek alphabet letter.
; Arguments:
;  - arg0: Character code to test
; Returns:
;  - true: The character is in the class of Greek letters
;  - false: The character is something other than Greek
	pop	de
	pop	hl
	push	hl
	push	de
	ld	a, e
	ld	hl, .data
	ld	bc, .data_end - .data
	cpir
	ld	a, c
	ret	nz
	inc	a
	ret
.data:
	db	$81, $83, $85, $8F, $90, $98, $99, $9D, $A5, $A6, $A8, $A9, $AE, $AF, $B4, $B5, $B8
.data_end:


if defined GREEK_CASE_CHANGABLE
;-------------------------------------------------------------------------------
_disable_greek_case_change:
; Disables changing case on Greek letters.
; Arguments:
;  - None
; Returns:
;  - Nothing
	ld	hl, _strupper.greek + 3
	bit	7, (hl)
	ret	z
	jr	_enable_greek_case_change.start
;-------------------------------------------------------------------------------
_enable_greek_case_change:
; Enables changing case on Greek letters.
; Arguments:
;  - None
; Returns:
;  - Nothing
	ld	hl, _strupper.greek + 2
	bit	7, (hl)
	ret	nz
.start:
	dec	hl
	dec	hl
	ld	de, _strupper.nogreek
	ld	bc, _strupper.greek_len
	call	.exchange
	ld	hl, _strlower.greek
	ld	de, _strlower.nogreek
	ld	bc, _strlower.greek_len
.exchange:
	ld	a, (de)
	ldi
	dec	hl
	ld	(hl), a
	inc	hl
	jp	pe, .exchange
	ret
end if


if defined GREEK_CASE_METHOD_2_WHICH_IS_NOT_CURRENTLY_USED
; Not used because it's a fair bit bigger.  Note that using this also requires
; expanding the lowercase Greek table to match the uppercase one.
;-------------------------------------------------------------------------------
_disable_greek_case_change:
; Disables changing case on Greek letters.
; Arguments:
;  - None
; Returns:
;  - Nothing
	ld	hl, _strupper.greek + 2
	bit	7, (hl)
	ret	z
	jr	_enable_greek_case_change.start
;-------------------------------------------------------------------------------
_enable_greek_case_change:
; Enables changing case on Greek letters.
; Arguments:
;  - None
; Returns:
;  - Nothing
	ld	hl, _strupper.greek + 2
	bit	7, (hl)
	ret	nz
.start:
	dec	hl
	dec	hl
	ld	de, _strupper.nogreek
	call	.exchange
	ld	hl, _strlower.greek
	ld	de, _strlower.nogreek
exchange:
	push	hl
	push	de
	ld	iy, -greek_len
	add	iy, sp
	ld	sp, iy
	; (HL) -> stack
	lea	de, iy - greek_len
	ld	bc, greek_len
	ldir
	; (DE) -> (HL)
	ld	hl, (iy + 0)
	ld	de, (iy + 3)
	ld	bc, greek_len
	ldir
	; stack -> (HL)
	lea	hl, iy - greek_len
	ld	de, (iy + 3)
	ld	bc, greek_len
	ldir
	lea	iy, iy + greek_len + 6
	ld	sp, iy
	ret
end if