RAM_SIZE = $40
ROM_START = $800
ROM_SIZE = $800
WIDTH = 480
HEIGHT = 999
COLORS = 4
LINE_HEIGHT = 10
FONT_WIDTH = 6
FONT_SIZES = 4
DASH_LENGTHS = 16
MARGIN_STEPS = 30
SETTLE_WAIT = 11382
IEC .block
ATN_IN = %00000001
CLK_IN = %00000010
ATN_ACK = %00100000
DATA_OUT = %01000000
DATA_IN = %10000000
FIRST_DEVICE = 4
DEVICE_NUMBERS = 8
LISTEN = $20
SECOND = $60
WAIT = 3800
.bend
PEN .block
IDLE = %00
UP = %01
DOWN = %10
WAIT = 4943
STEPS = 35
.bend
port .block
a = $80
b = $81
c = $82
d = $83
iec = a
io = b
pen = c
stepper = d
.bend
latch_l = $85
latch_now = $88
control = $8f
*= $00
coord_s .struct
x .word ?
y .word ?
.ends
accu .word ?
longer .word ?
shorter .word ?
cmd .dstruct coord_s
absorig .dstruct coord_s
relorig .dstruct coord_s
num_temp .word ?
num_neg .byte ?
count .byte ?
fontp .word ?
upper_lower .byte ?
quote_counter .byte ?
underline .byte ?
font_tmp .byte ?
char_size .byte ?
current_color .byte ?
color .byte ?
cmd_use_pen .byte ?
pen_state .byte ?
char_rotation .byte ?
dashed .byte ?
dash_counter .byte ?
.byte ?
.union
.struct
step .block
x .byte ?
.byte ?
y .byte ?
.bend
.ends
.struct
.byte ?
sign .block
x .byte ?
.byte ?
y .byte ?
.bend
.ends
.endu
stepper .block
x .byte ?
padding .byte ?
y .byte ?
.bend
was_x = stepper.padding
serial_buf .byte ?
serial_eot .byte ?
.cerror * > RAM_SIZE - 10, "Too many RAM variables"
*= ROM_START
font .block
LOW_LINE = $5c
PI = $5e
SQUARE = $5f
convert .function *v
.endf (v >> 8) | ((v & 7) << 1) | (v & $70)
.byte $ff
.shift convert($000)
.shift convert($021, $122, $132, $131, $121, $023, $127, $137, $133, $123)
.shift convert($017, $116, $037, $136)
.shift convert($012, $116, $036, $132, $043, $103, $005, $145)
.shift convert($012, $132, $143, $134, $114, $105, $116, $136, $027, $121)
.shift convert($002, $146, $016, $106, $105, $115, $116, $033, $143, $142, $132, $133)
.shift convert($041, $105, $106, $117, $126, $125, $103, $102, $111, $121, $143)
.shift convert($025, $127)
.shift convert($031, $121, $112, $116, $127, $137)
.shift convert($021, $131, $142, $146, $137, $127)
.shift convert($002, $146, $006, $142, $026, $122)
.shift convert($022, $126, $004, $144)
.shift convert($020, $131, $132, $122, $121, $131)
.shift convert($004, $144)
.shift convert($021, $122, $132, $131, $121)
.shift convert($001, $156)
.shift convert($002, $146, $137, $117, $106, $102, $111, $131, $142, $146)
.shift convert($016, $127, $121, $011, $131)
.shift convert($006, $117, $137, $146, $145, $101, $141)
.shift convert($006, $117, $137, $146, $145, $134, $124, $034, $143, $142, $131, $111, $102)
.shift convert($031, $137, $104, $103, $143)
.shift convert($002, $111, $131, $142, $144, $135, $105, $107, $147)
.shift convert($004, $115, $135, $144, $142, $131, $111, $102, $106, $117, $137, $146)
.shift convert($001, $145, $147, $107)
.shift convert($014, $105, $106, $117, $137, $146, $145, $134, $143, $142, $131, $111, $102, $103, $114, $134)
.shift convert($002, $111, $131, $142, $146, $137, $117, $106, $105, $114, $134, $145)
.shift convert($012, $113, $123, $122, $112, $015, $116, $126, $125, $115)
.shift convert($011, $122, $123, $113, $112, $122, $025, $126, $116, $115, $125)
.shift convert($041, $114, $147)
.shift convert($013, $143, $015, $145)
.shift convert($011, $144, $117)
.shift convert($006, $117, $137, $146, $145, $134, $124, $123, $022, $121)
.shift convert($033, $135, $115, $112, $132, $143, $145, $136, $116, $105, $102, $111, $141)
.shift convert($001, $105, $127, $145, $141, $004, $144)
.shift convert($001, $107, $137, $146, $145, $134, $004, $134, $143, $142, $131, $101)
.shift convert($042, $131, $111, $102, $106, $117, $137, $146)
.shift convert($001, $107, $137, $146, $142, $131, $101)
.shift convert($041, $101, $107, $147, $034, $104)
.shift convert($001, $107, $147, $004, $134)
.shift convert($046, $137, $117, $106, $102, $111, $141, $144, $124)
.shift convert($001, $107, $047, $141, $004, $144)
.shift convert($011, $131, $021, $127, $017, $137)
.shift convert($002, $111, $121, $132, $137)
.shift convert($001, $107, $047, $103, $014, $141)
.shift convert($007, $101, $141)
.shift convert($001, $107, $125, $124, $125, $147, $141)
.shift convert($001, $107, $006, $142, $047, $141)
.shift convert($002, $106, $117, $137, $146, $142, $131, $111, $102)
.shift convert($001, $107, $137, $146, $145, $134, $104)
.shift convert($023, $141, $031, $111, $102, $106, $117, $137, $146, $142, $131)
.shift convert($001, $107, $137, $146, $145, $134, $104, $014, $141)
.shift convert($002, $111, $131, $142, $143, $134, $114, $105, $106, $117, $137, $146)
.shift convert($021, $127, $007, $147)
.shift convert($007, $102, $111, $131, $142, $147)
.shift convert($007, $103, $121, $143, $147)
.shift convert($007, $101, $123, $024, $123, $141, $147)
.shift convert($001, $102, $146, $147, $007, $106, $142, $141)
.shift convert($021, $124, $146, $147, $007, $106, $124)
.shift convert($007, $147, $146, $102, $101, $141)
.shift convert($021, $101, $107, $127)
.shift convert($056, $146, $135, $132, $121, $111, $102, $113, $131, $151, $024, $144)
.shift convert($011, $131, $137, $117)
.shift convert($021, $126, $004, $126, $144)
.shift convert($022, $104, $126, $004, $154)
.shift convert($004, $174)
.shift convert($032, $121, $111, $102, $103, $114, $124, $133, $005, $125, $134, $132, $141)
.shift convert($007, $101, $121, $132, $134, $125, $105)
.shift convert($032, $121, $111, $102, $104, $115, $125, $134)
.shift convert($035, $115, $104, $102, $111, $131, $137)
.shift convert($003, $133, $134, $125, $115, $104, $102, $111, $131)
.shift convert($021, $127, $137, $014, $134)
.shift convert($001, $110, $120, $131, $134, $125, $115, $104, $103, $112, $122, $133)
.shift convert($001, $107, $005, $125, $134, $131)
.shift convert($021, $124, $025, $126)
.shift convert($001, $110, $120, $131, $134, $035, $136)
.shift convert($031, $113, $007, $101, $002, $135)
.shift convert($017, $111, $121)
.shift convert($001, $105, $004, $115, $124, $121, $024, $135, $144, $141)
.shift convert($001, $105, $104, $115, $125, $134, $131)
.shift convert($002, $104, $115, $125, $134, $132, $121, $111, $102)
.shift convert($002, $122, $133, $134, $125, $105, $100)
.shift convert($040, $130, $135, $115, $104, $103, $112, $132)
.shift convert($005, $114, $111, $014, $125, $135)
.shift convert($002, $111, $121, $132, $123, $113, $104, $115, $125, $134)
.shift convert($005, $125, $017, $111, $121)
.shift convert($005, $101, $131, $135)
.shift convert($005, $103, $121, $143, $145)
.shift convert($005, $102, $111, $122, $123, $122, $131, $142, $145)
.shift convert($001, $145, $005, $141)
.shift convert($005, $104, $122, $045, $144, $100)
.shift convert($005, $145, $101, $141)
.shift convert($030, $137)
.shift convert($070, $100)
.shift convert($001, $134, $161, $101)
.shift convert($003, $114, $134, $131, $011, $114, $134, $145)
.shift convert($001, $107, $157, $151, $101)
.bend
reset sei
ldx #RAM_SIZE-1
txs
lda #~IEC.DATA_OUT
sta port.iec
ldx #$ff
stx port.io
stx port.pen
inx
stx port.stepper
lda #%11100000
sta control
txa
ldx #RAM_SIZE-3
zp_init sta 0,x
dex
bne zp_init
jsr line_feed
lda #4
sta count
lsr
sta char_size
stepper_init ldx #round((WIDTH + MARGIN_STEPS * 2.5) / 4)
jsr stepper_left
dec count
bne stepper_init
lda #COLORS * 3
sta count
pen_init jsr stepper_rl
lda port.pen
bpl pen_ok
dec count
bne pen_init
flash_led dex
stx port.io
jsr wait_settle
sta port.stepper
beq flash_led
pen_ok ldx #PEN.STEPS + MARGIN_STEPS + 2
jsr stepper_right
- jsr next_color
ldx #font.SQUARE
jsr print_char
lda color
bne -
dec char_size
paper_feed jsr carriage_return
idle_loop jsr wait_settle
sta port.stepper
iec_loop2 jsr atnack_hi
iec_loop lda port.io
bpl paper_feed
asl
bmi nchange
jsr next_color
beq idle_loop
nchange asl
bmi nremove
lda #>(WIDTH + 255)
sta cmd.x+1
jsr move_abs_pup
nremove jsr check_iec
bpl iec_loop
lda #IEC.DATA_OUT | IEC.ATN_ACK
jsr set_iec_lines
jsr wait_iec
jsr iecin
lda port.io
and #IEC.DEVICE_NUMBERS-1
clc
adc #IEC.LISTEN + IEC.FIRST_DEVICE
cmp serial_buf
beq device_ok
iec_skip jsr data_hi_check
bmi iec_skip
bpl iec_loop2
.cerror IEC.DEVICE_NUMBERS & (IEC.DEVICE_NUMBERS - 1), "Number of modes must be power of two"
device_ok jsr check_iec
bcs device_ok
lda #IEC.SECOND
sta serial_buf
jsr check_iec
bpl +
jsr iecin
+ lda serial_buf
cmp #IEC.SECOND
blt iec_skip
cmp #IEC.SECOND + size(modes)/2
bge iec_skip
and #size(modes)/2-1
asl
tay
lda modes+1,y
pha
lda modes,y
pha
cpy #modes.with_param - modes
blt +
jsr iecin_number
tya
+ rts
.cerror size(modes) & (size(modes) - 1), "Number of modes must be power of two"
modes .block
.rta petscii_mode
.rta plotter_mode
with_param .rta set_color
.rta set_size
.rta set_rotation
.rta set_dashed
.rta set_uplower
.rta reset
.bend
set_color jsr select_pen
beq skip_rest
.cerror FONT_SIZES & (FONT_SIZES - 1), "Font sizes must be a power of 2"
set_size and #FONT_SIZES-1
sta char_size
bpl skip_rest
set_rotation sta char_rotation
bpl skip_rest
.cerror DASH_LENGTHS & (DASH_LENGTHS - 1), "Dash length must be a power of 2"
set_dashed and #DASH_LENGTHS-1
sta dashed
bpl skip_rest
set_uplower and #1
lsr
ror
sta upper_lower
bcc skip_rest
- jsr iecin
skip_rest lda serial_eot
beq -
jmp idle_loop
iecin2 lda serial_eot
eor #%11111111
beq at_eot
iecin jsr check_iec
bcs iecin
- jsr data_hi_check
and #IEC.DATA_IN >> 2
bne -
sta serial_eot
ldx #9
- jsr check_iec
bcs neot
dex
bne -
jsr data_lo
dec serial_eot
ldx #7
- dex
bne -
jsr data_hi_check
neot ldx #8
iecbitloop lda port.iec
and #IEC.CLK_IN
beq iecbitloop
- lda port.iec
and #IEC.CLK_IN
bne -
lda port.iec
eor #$ff
asl
ror serial_buf
dex
bne iecbitloop
- jsr check_iec
bcc -
jsr data_lo
ldx #20
- dex
bne -
lda serial_eot
bpl +
jsr atnack_hi
+ lda serial_buf
cmp #"{cr}"
at_eot rts
atn_hi lda #IEC.ATN_ACK
bne set_iec_lines
data_lo lda #IEC.DATA_OUT
set_iec_lines ora port.iec
bne sta_iec
atnack_hi lda #~IEC.ATN_ACK
and port.iec
sta port.iec
data_hi_check lda #~IEC.DATA_OUT
and port.iec
sta_iec sta port.iec
check_iec lda port.iec
cmp port.iec
bne check_iec
lsr
ror
rts
petscii_mode jsr iecin
beq do_cr
cmp #"{lf}"
beq do_cr
cmp #"{shift return}"
beq do_shcr
cmp #"{pi}"
bne +
lda #font.PI + $80
+ cmp #'"'
bne +
inc quote_counter
+ eor upper_lower
sta serial_buf
and #%01111111
sec
sbc #32
bge +
lda quote_counter
and #1
sta underline
beq nextchar
lda serial_buf
and #%01111111
ora #%00100000
+ cmp #64
bge nextchar
cmp #32
blt +
ldx serial_buf
bpl +
adc #%00011111
+ sta serial_buf
jsr in_printarea_x
bcc +
jsr carriage_return
+ jsr print_buf
lsr underline
bcc nextchar
jsr set_absorigin
ldx #font.LOW_LINE
jsr print_char
nextchar lda serial_eot
beq petscii_mode
bne skip_rest2
do_cr jsr carriage_return
stx quote_counter
stx underline
beq nextchar
do_shcr jsr move_left_side
beq nextchar
plotter_mode jsr iecin
stx cmd_use_pen
cmp #"i"
bne +
jsr set_relorigin
+ cmp #"h"
bne +
jsr set_absorigin
+ cmp #"m"
beq nuse_pen
cmp #"r"
beq nuse_pen
cmp #"d"
beq +
cmp #"j"
bne skip_rest2
+ inc cmd_use_pen
nuse_pen pha
jsr iecin_number
sty cmd.x
sta cmd.x+1
jsr iecin_number
sty cmd.y
sta cmd.y+1
pla
and #%00000100
beq +
jsr move_abs
beq skip_rest2
+ jsr move_rel
skip_rest2 jmp skip_rest
.cerror HEIGHT > 10000, "Coordinate overflow possible"
iecin_number lda #ceil(log10(HEIGHT-1))
sta count
jsr num_clr
- jsr iecin2
beq num_end
cmp #"."
beq digits_finished
cmp #"-"
bne +
dec num_neg
+ jsr is_digit
bcs -
next_digit pha
asl num_temp
rol num_temp+1
ldx num_temp
ldy num_temp+1
asl num_temp
rol num_temp+1
asl num_temp
rol num_temp+1
clc
txa
adc num_temp
sta num_temp
tya
adc num_temp+1
sta num_temp+1
pla
clc
adc num_temp
sta num_temp
bcc +
inc num_temp+1
+ dec count
beq digits_finished
jsr iecin2
beq num_end
jsr is_digit
bcc next_digit
- cmp #"e"
bne +
jsr num_clr
+ cmp #" "
beq num_end
cmp #","
beq num_end
digits_finished jsr iecin2
bne -
num_end ldy num_temp
lda num_temp+1
ldx num_neg
beq nneg
negate pha
tya
eor #$ff
tay
pla
eor #$ff
iny
bne nneg
clc
adc #1
nneg rts
num_clr lda #0
sta num_neg
sta num_temp
sta num_temp+1
rts
is_digit tax
sec
sbc #"0"
blt +
cmp #10
blt its_digit
+ txa
sec
its_digit rts
print_buf ldx serial_buf
print_char inx
lda #>font
sta fontp+1
ldy #<font
sty fontp
- lda (fontp),y
bpl +
dex
beq char_found
+ inc fontp
bne -
inc fontp+1
bne -
char_found jsr set_relorigin
print_loop ldy #1
lda (fontp),y
sta font_tmp
print_last lsr
tax
and #%111
sta cmd.y
lda #0
sta cmd.x+1
sta cmd.y+1
rol
sta cmd_use_pen
txa
lsr
lsr
lsr
and #%111
sta cmd.x
ldx font_tmp
inx
beq +
lda char_rotation
beq +
ldy cmd.y
lda cmd.x
eor #%111
sta cmd.y
sty cmd.x
+ ldx char_size
beq +
- asl cmd.x
rol cmd.x+1
asl cmd.y
rol cmd.y+1
dex
bne -
+ jsr move_rel
inc fontp
bne +
inc fontp+1
+ lda font_tmp
bpl print_loop
cmp #$ff
beq +
lda #$ff
sta font_tmp
lda #$80 + (FONT_WIDTH << 4)
bne print_last
+ rts
move_rel ldx #coord_s.y
- clc
lda cmd,x
adc relorig,x
sta cmd,x
lda cmd+1,x
adc relorig+1,x
sta cmd+1,x
dex
dex
beq -
move_abs ldx #coord_s.y
- sec
lda cmd,x
sbc absorig,x
sta cmd,x
lda cmd+1,x
sbc absorig+1,x
sta cmd+1,x
dex
dex
beq -
ldx #coord_s.y
- ldy cmd,x
lda cmd+1,x
sta sign,x
bpl +
jsr negate
sta cmd+1,x
sty cmd,x
+ dex
dex
beq -
sec
lda cmd.y
sbc cmd.x
lda cmd.y+1
sbc cmd.x+1
lda #0
sta dash_counter
rol
rol
tax
lda cmd+1,x
sta longer+1
lsr
sta accu+1
lda cmd,x
sta longer
ror
sta accu
txa
eor #coord_s.y
tax
sta was_x
lda cmd,x
sta shorter
lda cmd+1,x
sta shorter+1
move_loop lda cmd.x
ora cmd.x+1
bne +
lda cmd.y
ora cmd.y+1
bne move_v1
rts
+ lda cmd.y
ora cmd.y+1
beq move_h1
sec
lda accu
sbc shorter
sta accu
lda accu+1
sbc shorter+1
sta accu+1
blt overf
lda was_x
beq move_v1
move_h1 inc step.x
bne +
overf clc
lda accu
adc longer
sta accu
lda accu+1
adc longer+1
sta accu+1
inc step.x
move_v1 inc step.y
+ ldx #coord_s.y
move_xy_loop lda sign,x
bmi +
jsr step1
+ ldy absorig,x
lda absorig+1,x
bpl +
jsr negate
+ pha
tya
sec
sbc #<HEIGHT
pla
sbc #>HEIGHT
bge +
txa
bne move_ib
.cerror HEIGHT < WIDTH, "Width can't be smaller than height"
jsr in_printarea_x
bcc move_ib
+ rol cmd_use_pen
sec
ror cmd_use_pen
bmi move_oob
move_ib lda step,x
beq nstep
lda sign,x
bmi +
inc stepper,x
inc stepper,x
+ dec stepper,x
move_oob lda step,x
beq nstep
lda cmd,x
bne +
dec cmd+1,x
+ dec cmd,x
nstep lda sign,x
bpl +
jsr step1
+ dex
dex
beq move_xy_loop
lda cmd_use_pen
bpl +
lda #0
sta cmd_use_pen
sta pen_state
+ beq pen_up
ldx dashed
beq pen_down
lda dash_counter
bne skip_pen
stx dash_counter
lda pen_state
and #PEN.UP
beq pen_down
pen_up ldx #~PEN.UP
bne +
pen_down ldx #~PEN.DOWN
+ cpx pen_state
beq skip_pen
cpx #~PEN.DOWN
beq +
jsr wait_pen
+ stx port.pen
stx pen_state
jsr wait_pen
lda #~PEN.IDLE
sta port.pen
skip_pen jsr set_stepper
sta step.x
sta step.y
dec dash_counter
jmp move_loop
step1 ldy step,x
beq +
asl
bcs step1_m
inc absorig,x
bne +
inc absorig+1,x
+ rts
step1_m lda absorig,x
bne +
dec absorig+1,x
+ dec absorig,x
rts
in_printarea_x sec
lda absorig.x
sbc #<WIDTH
lda absorig.x+1
sbc #>WIDTH
rts
set_stepper lda stepper.x
and #size(stepconst.x)-1
tay
lda stepconst.x,y
pha
lda stepper.y
and #size(stepconst.y)-1
tay
pla
ora stepconst.y,y
sta port.stepper
wait_iec lda #<IEC.WAIT
ldy #>IEC.WAIT
bne wait
wait_pen lda #<PEN.WAIT
ldy #>PEN.WAIT
bne wait
wait_settle lda #<SETTLE_WAIT
ldy #>SETTLE_WAIT
wait sta latch_l
sty latch_now
- lda control
bpl -
lda #0
rts
stepconst .block
consts = [%1001, %1010, %0110, %0101]
x .byte consts
y .byte consts << 4
.bend
carriage_return jsr move_left_side
.cerror (LINE_HEIGHT / 2 * FONT_SIZES) > 255, "Line height too big"
line_feed ldx char_size
inx
lda #LINE_HEIGHT / 2
- asl
dex
bne -
sta absorig.y
stx absorig.y+1
jsr move_abs_pup
set_relorigin ldx #size(relorig)
- lda absorig-1,x
sta relorig-1,x
dex
bne -
rts
set_absorigin ldx #size(cmd)
- lda relorig-1,x
sta cmd-1,x
dex
bne -
beq move_abs_pup
move_left_side lda #0
sta cmd.x
sta cmd.x+1
beq move_horiz
next_color inc color
lda color
.cerror COLORS & (COLORS - 1), "Colors must be a power of 2"
select_pen and #COLORS-1
sta color
lda current_color
cmp color
beq same_color
lda absorig.x
pha
lda absorig.x+1
pha
jsr pen_up
jsr move_left_side
- ldx #PEN.STEPS + MARGIN_STEPS
jsr stepper_left
jsr stepper_rl
jsr stepper_rl
ldx #PEN.STEPS + MARGIN_STEPS
jsr stepper_right
inc current_color
lda current_color
and #COLORS-1
sta current_color
cmp color
bne -
pla
sta cmd.x+1
pla
sta cmd.x
move_horiz lda absorig.y
sta cmd.y
lda absorig.y+1
sta cmd.y+1
move_abs_pup lda #%10000000
sta cmd_use_pen
jmp move_abs
stepper_rl jsr stepper_r
ldx #PEN.STEPS
stepper_left dec stepper.x
jsr set_stepper
dex
bne stepper_left
same_color rts
stepper_r ldx #PEN.STEPS
stepper_right inc stepper.x
jsr set_stepper
dex
bne stepper_right
rts
.cerror * > vectors, "Code too long by ", * - vectors, " bytes"
.fill vectors - *, $aa
*= ROM_START + ROM_SIZE - size(vectors)
vectors .word reset, reset, reset