added txt.cls() as a shorter alternative to clear_screen().

cx16: added new character encodings, and routines in textio to enable the character sets for them.
cx16: added txt.chrout_lit() and txt.print_lit() to always print the literal characters and never as control codes
This commit is contained in:
Irmen de Jong 2024-04-07 19:32:44 +02:00
parent 8dd3faf395
commit ddb8346711
24 changed files with 275 additions and 39 deletions

View File

@ -5,7 +5,10 @@ enum class Encoding(val prefix: String) {
PETSCII("petscii"), // c64/c128/cx16
SCREENCODES("sc"), // c64/c128/cx16
ATASCII("atascii"), // atari
ISO("iso") // cx16
ISO("iso"), // cx16 (iso-8859-15)
ISO5("iso5"), // cx16 (iso-8859-5, cyrillic)
ISO16("iso16"), // cx16 (iso-8859-16, eastern european)
CP437("cp437") // cx16 (ibm pc, codepage 437)
}
interface IStringEncoding {

View File

@ -4,9 +4,7 @@ import com.github.michaelbull.result.fold
import prog8.code.core.Encoding
import prog8.code.core.IStringEncoding
import prog8.code.core.InternalCompilerException
import prog8.code.target.cbm.AtasciiEncoding
import prog8.code.target.cbm.IsoEncoding
import prog8.code.target.cbm.PetsciiEncoding
import prog8.code.target.encodings.*
object Encoder: IStringEncoding {
@ -18,6 +16,9 @@ object Encoder: IStringEncoding {
Encoding.SCREENCODES -> PetsciiEncoding.encodeScreencode(str, true)
Encoding.ISO -> IsoEncoding.encode(str)
Encoding.ATASCII -> AtasciiEncoding.encode(str)
Encoding.ISO5 -> IsoCyrillicEncoding.encode(str)
Encoding.ISO16 -> IsoEasternEncoding.encode(str)
Encoding.CP437 -> Cp437Encoding.encode(str)
else -> throw InternalCompilerException("unsupported encoding $encoding")
}
return coded.fold(
@ -31,6 +32,9 @@ object Encoder: IStringEncoding {
Encoding.SCREENCODES -> PetsciiEncoding.decodeScreencode(bytes, true)
Encoding.ISO -> IsoEncoding.decode(bytes)
Encoding.ATASCII -> AtasciiEncoding.decode(bytes)
Encoding.ISO5 -> IsoCyrillicEncoding.decode(bytes)
Encoding.ISO16 -> IsoEasternEncoding.decode(bytes)
Encoding.CP437 -> Cp437Encoding.decode(bytes)
else -> throw InternalCompilerException("unsupported encoding $encoding")
}
return decoded.fold(

View File

@ -1,4 +1,4 @@
package prog8.code.target.cbm
package prog8.code.target.encodings
import com.github.michaelbull.result.Ok
import com.github.michaelbull.result.Result

View File

@ -0,0 +1,68 @@
package prog8.code.target.encodings
import com.github.michaelbull.result.Err
import com.github.michaelbull.result.Ok
import com.github.michaelbull.result.Result
import java.io.CharConversionException
import java.nio.charset.Charset
object Cp437Encoding {
val charset: Charset = Charset.forName("IBM437")
fun encode(str: String): Result<List<UByte>, CharConversionException> {
return try {
val mapped = str.map { chr ->
when (chr) {
'\u0000' -> 0u
'☺' -> 1u
'☻' -> 2u
'♥' -> 3u
'♦' -> 4u
'♣' -> 5u
'♠' -> 6u
'•' -> 7u
'◘' -> 8u
'○' -> 9u
'◙' -> 10u
'♂' -> 11u
'♀' -> 12u
'♪' -> 13u
'♫' -> 14u
'☼' -> 15u
'►' -> 16u
'◄' -> 17u
'↕' -> 18u
'‼' -> 19u
'¶' -> 20u
'§' -> 21u
'▬' -> 22u
'↨' -> 23u
'↑' -> 24u
'↓' -> 25u
'→' -> 26u
'←' -> 27u
'∟' -> 28u
'↔' -> 29u
'▲' -> 30u
'▼' -> 31u
in '\u8000'..'\u80ff' -> {
// special case: take the lower 8 bit hex value directly
(chr.code - 0x8000).toUByte()
}
else -> charset.encode(chr.toString())[0].toUByte()
}
}
Ok(mapped)
} catch (ce: CharConversionException) {
Err(ce)
}
}
fun decode(bytes: Iterable<UByte>): Result<String, CharConversionException> {
return try {
Ok(String(bytes.map { it.toByte() }.toByteArray(), charset))
} catch (ce: CharConversionException) {
Err(ce)
}
}
}

View File

@ -1,4 +1,4 @@
package prog8.code.target.cbm
package prog8.code.target.encodings
import com.github.michaelbull.result.Err
import com.github.michaelbull.result.Ok
@ -6,8 +6,8 @@ import com.github.michaelbull.result.Result
import java.io.CharConversionException
import java.nio.charset.Charset
object IsoEncoding {
val charset: Charset = Charset.forName("ISO-8859-15")
open class IsoEncodingBase(charsetName: String) {
val charset: Charset = Charset.forName(charsetName)
fun encode(str: String): Result<List<UByte>, CharConversionException> {
return try {
@ -35,3 +35,8 @@ object IsoEncoding {
}
}
}
object IsoEncoding: IsoEncodingBase("ISO-8859-15")
object IsoCyrillicEncoding: IsoEncodingBase("ISO-8859-5")
object IsoEasternEncoding: IsoEncodingBase("ISO-8859-16")

View File

@ -1,4 +1,4 @@
package prog8.code.target.cbm
package prog8.code.target.encodings
import com.github.michaelbull.result.Err
import com.github.michaelbull.result.Ok

View File

@ -16,6 +16,10 @@ sub clear_screen() {
chrout(125)
}
sub cls() {
chrout(125)
}
sub nl() {
chrout('\n')
}
@ -147,15 +151,15 @@ _tmp_outchar
}
asmsub print (str text @ AY) clobbers(A,Y) {
; ---- print null terminated string from A/Y
; ---- print zero terminated string from A/Y
; note: the compiler contains an optimization that will replace
; a call to this subroutine with a string argument of just one char,
; by just one call to CHROUT of that single char.
%asm {{
sta P8ZP_SCRATCH_B1
sty P8ZP_SCRATCH_REG
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy #0
- lda (P8ZP_SCRATCH_B1),y
- lda (P8ZP_SCRATCH_W2),y
beq +
jsr chrout
iny

View File

@ -93,11 +93,12 @@ romsub $FFD5 = LOAD(ubyte verify @ A, uword address @ XY) -> bool @Pc, ubyte @ A
romsub $FFD8 = SAVE(ubyte zp_startaddr @ A, uword endaddr @ XY) -> bool @ Pc, ubyte @ A ; (via 818 ($332)) save to a device
romsub $FFDB = SETTIM(ubyte low @ A, ubyte middle @ X, ubyte high @ Y) ; set the software clock
romsub $FFDE = RDTIM() -> ubyte @ A, ubyte @ X, ubyte @ Y ; read the software clock (A=lo,X=mid,Y=high)
romsub $FFE1 = STOP() clobbers(X) -> bool @ Pz, ubyte @ A ; (via 808 ($328)) check the STOP key (and some others in A) also see STOP2
romsub $FFE4 = GETIN() clobbers(X,Y) -> bool @Pc, ubyte @ A ; (via 810 ($32A)) get a character also see GETIN2
romsub $FFE1 = STOP() clobbers(X) -> bool @ Pz, ubyte @ A ; (via 808 ($328)) check the STOP key (and some others in A) also see STOP2
romsub $FFE4 = GETIN() clobbers(X,Y) -> bool @Pc, ubyte @ A ; (via 810 ($32A)) get a character also see GETIN2
romsub $FFE7 = CLALL() clobbers(A,X) ; (via 812 ($32C)) close all files
romsub $FFEA = UDTIM() clobbers(A,X) ; update the software clock
romsub $FFED = SCREEN() -> ubyte @ X, ubyte @ Y ; read number of screen rows and columns
romsub $FFED = SCREEN() -> ubyte @ X, ubyte @ Y ; get current window dimensions into X (columns) and Y (rows) NOTE: changed behavior compared to VIC/C64/PET SCREEN() routine!
romsub $FFED = SCRORG() -> ubyte @ X, ubyte @ Y ; get current window dimensions into X (columns) and Y (rows) NOTE: changed behavior compared to VIC/C64/PET SCREEN() routine!
romsub $FFF0 = PLOT(ubyte col @ Y, ubyte row @ X, bool dir @ Pc) clobbers(A) -> ubyte @ X, ubyte @ Y ; read/set position of cursor on screen. Use txt.plot for a 'safe' wrapper that preserves X.
romsub $FFF3 = IOBASE() -> uword @ XY ; read base address of I/O devices

View File

@ -20,6 +20,10 @@ sub clear_screen() {
chrout(147)
}
sub cls() {
chrout(147)
}
sub home() {
chrout(19)
}

View File

@ -94,11 +94,11 @@ romsub $FFD5 = LOAD(ubyte verify @ A, uword address @ XY) -> bool @Pc, ubyte @ A
romsub $FFD8 = SAVE(ubyte zp_startaddr @ A, uword endaddr @ XY) -> bool @ Pc, ubyte @ A ; (via 818 ($332)) save to a device
romsub $FFDB = SETTIM(ubyte low @ A, ubyte middle @ X, ubyte high @ Y) ; set the software clock
romsub $FFDE = RDTIM() -> ubyte @ A, ubyte @ X, ubyte @ Y ; read the software clock (A=lo,X=mid,Y=high)
romsub $FFE1 = STOP() clobbers(X) -> bool @ Pz, ubyte @ A ; (via 808 ($328)) check the STOP key (and some others in A) also see STOP2
romsub $FFE4 = GETIN() clobbers(X,Y) -> bool @Pc, ubyte @ A ; (via 810 ($32A)) get a character also see GETIN2
romsub $FFE1 = STOP() clobbers(X) -> bool @ Pz, ubyte @ A ; (via 808 ($328)) check the STOP key (and some others in A) also see STOP2
romsub $FFE4 = GETIN() clobbers(X,Y) -> bool @Pc, ubyte @ A ; (via 810 ($32A)) get a character also see GETIN2
romsub $FFE7 = CLALL() clobbers(A,X) ; (via 812 ($32C)) close all files
romsub $FFEA = UDTIM() clobbers(A,X) ; update the software clock
romsub $FFED = SCREEN() -> ubyte @ X, ubyte @ Y ; read number of screen rows and columns
romsub $FFED = SCREEN() -> ubyte @ X, ubyte @ Y ; get size of text screen into X (columns) and Y (rows)
romsub $FFF0 = PLOT(ubyte col @ Y, ubyte row @ X, bool dir @ Pc) clobbers(A) -> ubyte @ X, ubyte @ Y ; read/set position of cursor on screen. Use txt.plot for a 'safe' wrapper that preserves X.
romsub $FFF3 = IOBASE() -> uword @ XY ; read base address of I/O devices

View File

@ -19,6 +19,10 @@ sub clear_screen() {
chrout(147)
}
sub cls() {
chrout(147)
}
sub home() {
chrout(19)
}

View File

@ -47,7 +47,7 @@ romsub $FFE1 = STOP() clobbers(X) -> bool @ Pz, ubyte @ A ; (via 808 ($328
romsub $FFE4 = GETIN() clobbers(X,Y) -> bool @Pc, ubyte @ A ; (via 810 ($32A)) get a character also see GETIN2
romsub $FFE7 = CLALL() clobbers(A,X) ; (via 812 ($32C)) close all files
romsub $FFEA = UDTIM() clobbers(A,X) ; update the software clock
romsub $FFED = SCREEN() -> ubyte @ X, ubyte @ Y ; read number of screen rows and columns
romsub $FFED = SCREEN() -> ubyte @ X, ubyte @ Y ; get size of text screen into X (columns) and Y (rows)
romsub $FFF0 = PLOT(ubyte col @ Y, ubyte row @ X, bool dir @ Pc) clobbers(A) -> ubyte @ X, ubyte @ Y ; read/set position of cursor on screen. Also see txt.plot
romsub $FFF3 = IOBASE() -> uword @ XY ; read base address of I/O devices
@ -567,8 +567,7 @@ asmsub set_screen_mode(ubyte mode @A) clobbers(A,X,Y) -> bool @Pc {
}
asmsub get_screen_mode() -> ubyte @A, ubyte @X, ubyte @Y {
; -- convenience wrapper for screen_mode() to just get the current mode in A, and size in characters in X+Y
; this does need a piece of inlined asm to call it ans store the result values if you call this from prog8 code
; -- convenience wrapper for screen_mode() to just get the current mode in A, and size in characters in X (width) and Y (height)
; Note: you can also just do the SEC yourself and simply call screen_mode() directly,
; or use the existing SCREEN kernal routine for just getting the size in characters.
%asm {{

View File

@ -23,6 +23,10 @@ sub clear_screen() {
chrout(147)
}
sub cls() {
chrout(147)
}
sub home() {
chrout(19)
}
@ -225,8 +229,8 @@ sub uppercase() {
}
sub iso() {
; -- switch to iso-8859-15 character set
cbm.CHROUT($0f)
; This doesn't enable it completely: cx16.screen_set_charset(1, 0) ; iso charset
}
sub iso_off() {
@ -234,6 +238,29 @@ sub iso_off() {
cbm.CHROUT($8f)
}
sub cp437() {
; -- switch to CP-437 (ibm PC) character set
cbm.CHROUT($0f) ; iso mode
cx16.screen_set_charset(7, 0) ; charset
%asm {{
clc
ldx #95 ; underscore
lda #cx16.EXTAPI_iso_cursor_char
jsr cx16.extapi
}}
}
sub iso5() {
; -- switch to iso-8859-5 character set (Cyrillic)
cbm.CHROUT($0f) ; iso mode
cx16.screen_set_charset(8, 0) ; charset
}
sub iso16() {
; -- switch to iso-8859-16 character set (Eastern Europe)
cbm.CHROUT($0f) ; iso mode
cx16.screen_set_charset(10, 0) ; charset
}
asmsub scroll_left() clobbers(A, X, Y) {
; ---- scroll the whole screen 1 character to the left
@ -604,4 +631,35 @@ asmsub waitkey() -> ubyte @A {
rts
}}
}
asmsub chrout_lit(ubyte character @A) {
; -- print the character always as a literal character, not as possible control code.
%asm {{
tax
lda #128
jsr cbm.CHROUT
txa
jmp cbm.CHROUT
}}
}
asmsub print_lit(str text @ AY) clobbers(A,Y) {
; -- print zero terminated string, from A/Y, as all literal characters (no control codes)
%asm {{
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy #0
- lda (P8ZP_SCRATCH_W2),y
beq +
tax
lda #128
jsr cbm.CHROUT
txa
jsr cbm.CHROUT
iny
bne -
+ rts
}}
}
}

View File

@ -19,6 +19,10 @@ sub clear_screen() {
chrout(147)
}
sub cls() {
chrout(147)
}
sub home() {
chrout(19)
}

View File

@ -4,15 +4,15 @@ txt {
%option merge, no_symbol_prefixing, ignore_unused
asmsub print (str text @ AY) clobbers(A,Y) {
; ---- print null terminated string, in PETSCII encoding, from A/Y
; ---- print zero terminated string, in PETSCII encoding, from A/Y
; note: the compiler contains an optimization that will replace
; a call to this subroutine with a string argument of just one char,
; by just one call to cbm.CHROUT of that single char.
%asm {{
sta P8ZP_SCRATCH_B1
sty P8ZP_SCRATCH_REG
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy #0
- lda (P8ZP_SCRATCH_B1),y
- lda (P8ZP_SCRATCH_W2),y
beq +
jsr cbm.CHROUT
iny

View File

@ -28,6 +28,10 @@ sub clear_screen() {
}}
}
sub cls() {
clear_screen()
}
sub nl() {
chrout('\n')
}

View File

@ -115,6 +115,7 @@ class TestCompilerOnExamplesCx16: FunSpec({
"bdmusic",
"bobs",
"bubbleuniverse",
"charsets",
"circles",
"cobramk3-gfx",
"colorbars",

View File

@ -16,9 +16,9 @@ import prog8.code.core.unescape
import prog8.code.target.C64Target
import prog8.code.target.Cx16Target
import prog8.code.target.Encoder
import prog8.code.target.cbm.AtasciiEncoding
import prog8.code.target.cbm.IsoEncoding
import prog8.code.target.cbm.PetsciiEncoding
import prog8.code.target.encodings.AtasciiEncoding
import prog8.code.target.encodings.IsoEncoding
import prog8.code.target.encodings.PetsciiEncoding
import prog8tests.helpers.ErrorReporterForTests
import prog8tests.helpers.compileText

View File

@ -20,7 +20,7 @@ import prog8.ast.statements.*
import prog8.code.core.*
import prog8.code.target.C64Target
import prog8.code.target.VMTarget
import prog8.code.target.cbm.PetsciiEncoding
import prog8.code.target.encodings.PetsciiEncoding
import prog8.parser.ParseError
import prog8.parser.Prog8Parser.parseModule
import prog8tests.helpers.*

View File

@ -371,13 +371,14 @@ dedicated to Prog8. Other than that, use the issue tracker on github.
Examples
--------
A couple of example programs can be found in the 'examples' directory of the source tree.
Make sure you have installed the :ref:`requirements`. Then, for instance,
to compile and run the Commodore 64 rasterbars example program, use this command::
A bunch of example programs can be found in the 'examples' directory of the source tree.
There are cross-platform examples that can be compiled for various systems unaltered,
and there are also examples specific to certain computers (C64, X16, etcetera).
So for instance, to compile and run the Commodore 64 rasterbars example program, use this command::
$ java -jar prog8compiler.jar -target c64 -emu examples/rasterbars.p8
$ java -jar prog8compiler.jar -target c64 -emu examples/c64/rasterbars.p8
or::
$ /path/to/p8compile -target c64 -emu examples/rasterbars.p8
$ /path/to/p8compile -target c64 -emu examples/c64/rasterbars.p8

View File

@ -542,13 +542,16 @@ A string literal can occur with or without an encoding prefix (encoding followed
When this is omitted, the string is stored in the machine's default character encoding (which is PETSCII on the CBM machines).
You can choose to store the string in other encodings such as ``sc`` (screencodes) or ``iso`` (iso-8859-15).
String length is limited to 255 characters.
Here are several examples:
Here are examples of the various encodings:
- ``"hello"`` a string translated into the default character encoding (PETSCII on the CBM machines)
- ``petscii:"hello"`` string in CBM PETSCII encoding
- ``sc:"my name is Alice"`` string in CBM screencode encoding
- ``iso:"Ich heiße François"`` string in iso-8859-15 encoding
- ``iso:"Ich heiße François"`` string in iso-8859-15 encoding (Latin)
- ``iso5:"Хозяин и Работник"`` string in iso-8859-5 encoding (Cyrillic)
- ``iso16:"zażółć gęślą jaźń"`` string in iso-8859-16 encoding (Eastern Europe)
- ``atascii:"I am Atari!"`` string in "atascii" encoding (Atari 8-bit)
- ``cp437:"≈ IBM Pc ≈ ♂♀♪☺¶"`` string in "cp437" encoding (IBM PC codepage 437)
There are several escape sequences available to put special characters into your string value:

View File

@ -1,6 +1,14 @@
TODO
====
change meaning of sprite module's palette offset parameter to 0-15
fix routines such as mult in verafx to return both 16-bit words of the result.
ubyte x,y compiles to more code than ubyte x + ubyte y
can we make ubyte x,y = cbm.SCREEN() work?
...

65
examples/cx16/charsets.p8 Normal file
View File

@ -0,0 +1,65 @@
%import textio
%zeropage basicsafe
main {
str buf = "?" * 20
sub start() {
txt.print("a demonstration of the various non-petscii character sets in the x16.")
wait()
latin()
wait()
cyrillic()
wait()
eastern()
wait()
ibmpc()
}
sub latin() {
txt.iso()
repeat 3 txt.nl()
write_screencodes(iso:"Latin: Le garçon n'a pas acheté d'œuf.")
txt.print(iso:"Latin: Le garçon n'a pas acheté d'œuf.")
}
sub cyrillic() {
txt.iso5()
repeat 3 txt.nl()
write_screencodes(iso5:"Cyrillic: 'Хозяин и Работник' написана Лев Толстой.")
txt.print(iso5:"Cyrillic: 'Хозяин и Работник' написана Лев Толстой.")
}
sub eastern() {
txt.iso16()
repeat 3 txt.nl()
write_screencodes(iso16:"Eastern European: zażółć gęślą jaźń")
txt.print(iso16:"Eastern European: zażółć gęślą jaźń")
}
sub ibmpc() {
txt.color2(5,0)
void cx16.screen_mode(1,false)
txt.cp437()
repeat 3 txt.nl()
write_screencodes(cp437:"≈ IBM Pc ≈ ÇüéâäàåçêëèïîìÄ ░▒▓│┤╡╢╖╕╣║╗╝╜╛┐ ☺☻♥♦♣♠•◘○◙♂♀♪♫☼ ►◄↕‼¶§▬↨↑↓→←∟↔▲▼")
; regular print() won't work because of control codes (<32) in this one.
txt.print_lit(cp437:"≈ IBM Pc ≈ ÇüéâäàåçêëèïîìÄ ░▒▓│┤╡╢╖╕╣║╗╝╜╛┐ ☺☻♥♦♣♠•◘○◙♂♀♪♫☼ ►◄↕‼¶§▬↨↑↓→←∟↔▲▼")
txt.nl()
}
sub wait() {
txt.print("\n\npress enter: ")
void txt.input_chars(buf)
}
sub write_screencodes(str message) {
ubyte column=0
repeat {
if message[column]==0
return
txt.setchr(column, 1, message[column])
column++
}
}
}

View File

@ -12,7 +12,7 @@
<option name="HAS_STRING_ESCAPES" value="true" />
</options>
<keywords keywords="&amp;;-&gt;;@;and;as;asmsub;break;clobbers;continue;do;downto;else;false;for;goto;if;if_cc;if_cs;if_eq;if_mi;if_ne;if_neg;if_nz;if_pl;if_pos;if_vc;if_vs;if_z;in;inline;not;or;repeat;return;romsub;step;sub;to;true;unroll;until;when;while;xor;~" ignore_case="false" />
<keywords2 keywords="%address;%asm;%asmbinary;%asminclude;%breakpoint;%encoding;%import;%ir;%launcher;%option;%output;%zeropage;%zpallowed;%zpreserved;atascii:;default:;iso:;petscii:;sc:" />
<keywords2 keywords="%address;%asm;%asmbinary;%asminclude;%breakpoint;%encoding;%import;%ir;%launcher;%option;%output;%zeropage;%zpallowed;%zpreserved;atascii:;cp437:;default:;iso16:;iso5:;iso:;petscii:;sc:" />
<keywords3 keywords="@requirezp;@shared;@split;@zp;bool;byte;const;float;str;ubyte;uword;void;word" />
<keywords4 keywords="abs;all;any;call;callfar;clamp;cmp;divmod;len;lsb;max;memory;min;mkword;msb;peek;peekf;peekw;poke;pokef;pokew;reverse;rol;rol2;ror;ror2;rrestore;rrestorex;rsave;rsavex;setlsb;setmsb;sgn;sizeof;sort;sqrt;swap;|&gt;" />
</highlighting>