conio.pla

include "inc/cmdsys.plh"
include "inc/conio.plh"
sysflags nojitc // Keep tone() from compiling and sounding different
//
// Handy constants.
//
const FULLMODE     = 0
const MIXMODE      = 1
//
// Apple II ZP locations.
//
const a2rndnum = $4E // ZP location of RND
const a2rndl   = $4E
const a2rndh   = $4F
//
// Apple II hardware constants.
//
const speaker      = $C030
const showgraphics = $C050
const showtext     = $C051
const showfull     = $C052
const showmix      = $C053
const showpage1    = $C054
const showpage2    = $C055
const showlores    = $C056
const showhires    = $C057
const keyboard     = $C000
const keystrobe    = $C010
const hgr1         = $2000
const hgr2         = $4000
const page1        = 0
const page2        = 1
//
// Apple III hardware constants.
//
const ENV_REG      = $FFDF
//
// Predefined functions.
//
predef a2keypressed,a2home,a12echo(state),a2gotoxy(x,y),a2viewport(left, top, width, height),a2texttype(type)
predef a2textmode(cols),a2grmode(mix),a2grcolor(color),a2grplot(x,y),a2tone(duration, delay),a2rnd
//
// Exported function table.
//
word conio[]
//
// Function pointers.
//
word = @a2keypressed
word = @getc
word = @a12echo
word = @a2home
word = @a2gotoxy
word = @a2viewport
word = @a2texttype
word = @a2textmode
word = @a2grmode
word = @a2grcolor
word = @a2grplot
word = @a2tone
word = @a2rnd
//
// Screen row address arrays.
//
word txt1scrn[]     = $0400,$0480,$0500,$0580,$0600,$0680,$0700,$0780
word                = $0428,$04A8,$0528,$05A8,$0628,$06A8,$0728,$07A8
word                = $0450,$04D0,$0550,$05D0,$0650,$06D0,$0750,$07D0
word txt2scrn[]     = $0800,$0880,$0900,$0980,$0A00,$0A80,$0B00,$0B80
word                = $0828,$08A8,$0928,$09A8,$0A28,$0AA8,$0B28,$0BA8
word                = $0850,$08D0,$0950,$09D0,$0A50,$0AD0,$0B50,$0BD0
//
// Text screen parameters.
//
//byte textcols = 40
//byte curshpos = 0
//byte cursvpos = 0
//
// Apple 3 console codes.
//
byte textbwmode[]   = 2, 16, 0
byte textclrmode[]  = 2, 16, 1
byte grcharset[]    = 1, 0, $7F, $7F, $7F, $7F, $00, $00, $00, $00
byte a3keyqueue     = 0
//
// Random number for Apple 1 and III.
//
word randnum = 12345
//
// Native  routines.
//
asm equates
    !SOURCE "vmsrc/plvmzp.inc"
end
//
// def grscrn(rowaddrs)
//
asm a2grscrn(rowaddrs)
GRSCRN  =   $26
GRSCRNL =   GRSCRN
GRSCRNH =   GRSCRNL+1
    LDA ESTKL,X
    STA GRSCRNL
    LDA ESTKH,X
    STA GRSCRNH
    RTS
end
//
// def grcolor(color)
//
asm a2grcolor(color)
GRCLR   =   $30
    LDA #$0F
    AND ESTKL,X
    STA GRCLR
    ASL
    ASL
    ASL
    ASL
    ORA GRCLR
    STA GRCLR
    RTS
end
//
// def grplot(x, y)
//
asm a2grplot(x, y)
    STY IPY
    LDA ESTKL,X
    AND #$FE
    CMP ESTKL,X
    TAY
    LDA (GRSCRN),Y
    STA DSTL
    INY
    LDA (GRSCRN),Y
    STA DSTH
    LDY ESTKL+1,X
    LDA (DST),Y
    EOR GRCLR
    STA TMPL
    LDA #$FF
    ADC #$00
    EOR #$F0
    AND TMPL
    EOR GRCLR
    STA (DST),Y
    LDY IPY
    INX
    RTS
end
//
// Apple 1 routines.
//
def a1keypressed
    return ^$D011 >= 128 ?? ^$D011 :: 0
end
def a1getkey
    while not a1keypressed
        randnum = randnum + 123
    loop
    return getc()
end
def a12echo(state)
    return 0
end
def a1home
    byte l
    for l = 0 to 23
        putln
    next
    return 0
end
def a1gotoxy(x, y)
    //curshpos = x
    //cursvpos = y
    putln
    while x
        putc(' ')
        x = x - 1
    loop
    return 0
end
def a1viewport(left, top, width, height)
    return 0
end
def a1texttype(type)
    return 0
end
def a1textmode(columns)
    return 0
end
def a1grmode(mix)
    return 0 // not supported
end
def a1tone(duration, delay)
    byte i

    while duration
        for i = delay downto 0; next
        duration--
    loop
    return 0
end
//
// Apple II routines.
//
def a2keypressed
    return ^keyboard >= 128 ?? ^keyboard :: 0
end
def a2home
    //curshpos = 0
    //cursvpos = 0
    return call($FC58, 0, 0, 0, 0) // home()
end
def a2gotoxy(x, y)
    //curshpos = x
    //cursvpos = y
    ^$24 = x + ^$20
    return call($FB5B, y + ^$22, 0, 0, 0)
end
def a2viewport(left, top, width, height)
    if !width or !height
        left   = 0
        top    = 0
        width  = 40
        height = 24
    fin
    ^$20 = left
    ^$21 = width
    ^$22 = top
    ^$23 = height + top
    return a2gotoxy(0, 0)
end
def a2texttype(type)
    ^$32 = type
    return 0
end
def a2textmode(columns)
    call($FB39, 0, 0, 0, 0) // textmode()
    return a2home
end
def a2grmode(mix)
    call($FB2F, 0, 0, 0, 0) // initmode()
    call($FB40, 0, 0, 0, 0) // grmode()
    if !mix
        ^showfull
    fin
    a2home
    return a2grscrn(@txt1scrn) // point to lo-res screen
end
def a2tone(duration, delay)
    byte i

    while duration
        ^speaker // toggle speaker
        for i = delay downto 0; next
        duration--
    loop
    return 0
end
def a2rnd
    *a2rndnum = (*a2rndnum << 1) + *a2rndnum + 123
    return *a2rndnum & $7FFF
end
//
// Apple III routines.
//
def dev_control(devnum, code, list)
    byte params[5]

    params.0 = 3
    params.1 = devnum
    params.2 = code
    params:3 = list
    return syscall($83, @params)
end
def dev_status(devnum, code, list)
    byte params[5]

    params.0 = 3
    params.1 = devnum
    params.2 = code
    params:3 = list
    return syscall($82, @params)
end
def a3keypressed
    byte count

    dev_status(cmdsys.devcons, 5, @count)
    if count
        a3keyqueue = getc
    fin
    return a3keyqueue ?? a3keyqueue | $80 :: 0
end
def a3getkey
    byte keycode
    repeat
        randnum = randnum + 123
        a3keypressed
        keycode = a3keyqueue
    until keycode
    a3keyqueue = 0
    return keycode
end
def a3echo(state)
    return dev_control(cmdsys.devcons, 11, @state)
end
def a3home
    //curshpos = 0
    //cursvpos = 0
    putc(28)
    return 0
end
def a3gotoxy(x, y)
    //curshpos = x
    //cursvpos = y
    putc(24)
    putc(x)
    putc(25)
    putc(y)
    return 0
end
def a3viewport(left, top, width, height)
    if !width or !height
        //
        // Reset the full-screen viewport
        //
        left   = 0
        top    = 0
        width  = 40//textcols
        height = 24
    fin
    putc(1) // Reset viewport
    putc(26)
    putc(left)
    putc(top)
    putc(2)
    putc(26)
    putc(left + width  - 1)
    putc(top  + height - 1)
    putc(3)
    return a3gotoxy(0, 0)
end
def a3texttype(type)
    return 0
end
def a3textmode(columns)
    puts(@textbwmode)
    if columns > 40
        a3viewport(0, 0, 80, 24)
    else
        a3viewport(0, 0, 40, 24)
    fin
    putc(28)
    return 0
end
def a3grmode(mix)
    byte i
    if mix
        mix = 19
    else
        mix = 23
    fin
    puts(@textclrmode)
    dev_control(cmdsys.devcons, 17, @grcharset)
    a3viewport(0, 20, 40, 4)
    putc(28)
    for i = 0 to mix
        memset(txt1scrn[i], $0000, 40) // text  screen
        memset(txt2scrn[i], $0000, 40) // color screen
    next
    return a2grscrn(@txt2scrn) // point to color screen
end
def a3tone(duration, pitch)
    byte env

    env = ^ENV_REG
    ^ENV_REG = env | $C0
    a2tone(duration, pitch)
    ^ENV_REG = env
    return 0
end
//
// Apple 1 and III combined routines.
//
def a13rnd
    randnum = (randnum << 1) + randnum + 123
    return randnum & $7FFF
end
//
// Machine specific initialization.
//
when MACHID & MACHID_MODEL
    is MACHID_III
        conio:keypressed = @a3keypressed
        conio:getkey     = @a3getkey
        conio:echo       = @a3echo
        conio:home       = @a3home
        conio:gotoxy     = @a3gotoxy
        conio:viewport   = @a3viewport
        conio:texttype   = @a3texttype
        conio:textmode   = @a3textmode
        conio:grmode     = @a3grmode
        conio:tone       = @a3tone
        conio:rnd        = @a13rnd
        break
    is MACHID_I
        conio:keypressed = @a1keypressed
        conio:getkey     = @a1getkey
        conio:home       = @a1home
        conio:gotoxy     = @a1gotoxy
        conio:viewport   = @a1viewport
        conio:texttype   = @a1texttype
        conio:textmode   = @a1textmode
        conio:grmode     = @a1grmode
        conio:tone       = @a1tone
        conio:rnd        = @a13rnd
        break
    otherwise // MACHID_II        puts("Found MACHID_MODEL = $"); putb(MACHID & MACHID_MODEL); putln
wend
//
// Keep module in memory
//
return modkeep
done