















\ loadscreen fuer ATARI 8bit                          cas11aug06
\ 800 / 600 XL / 800 XL / 1200 XL / 130 XE / 65 XE / 800 XE

1  &14 +thru












\ 65KEY? GETKEY                                       cas11aug06

| $02FC Constant CH
| CODE 65KEY? ( -- FLAG) CH lda clc 1 # adc push0a jmp end-code

LABEL GETCHK $E425 lda pha $E424 lda pha rts
| CODE GETKEY  ( -- 8B) $FF sty $FE stx GETCHK jsr
$FE ldx $FF ldy  push0a jmp end-code

| $02F0 Constant CRSINH
| CODE CURON   ( --) 01 # lda
LABEL CRS01    CRSINH sta NEXT JMP END-CODE
| CODE CUROFF  ( --) 00 # lda CRS01 JMP END-CODE

: 65KEY  ( -- 8B)
CURON BEGIN PAUSE 65KEY?  UNTIL CUROFF GETKEY ;
\ DECODE EXPECT KEYBOARD      BP28MAY85)               cs08aug05
7E CONSTANT #BS   $9B CONSTANT #CR  &27 CONSTANT #ESC

: 65DECODE  ( ADDR CNT1 KEY -- ADDR CNT2)
#BS CASE?  IF  DUP  IF DEL 1- THEN EXIT  THEN
#CR CASE?  IF  DUP SPAN ! EXIT THEN
>R  2DUP +  R@ SWAP C!  R> EMIT  1+ ;

: 65EXPECT ( ADDR LEN1 -- )  SPAN !  0
BEGIN  DUP SPAN @  U<
WHILE  KEY  DECODE
REPEAT 2DROP SPACE ;

INPUT: KEYBOARD   [ HERE INPUT ! ]
65KEY 65KEY? 65DECODE 65EXPECT [

\ (emit 65emit        )                               cas11aug06

LABEL OUTCHK
$E407 lda pha $E406 lda pha txa rts

Code (emit ( 8b -- ) $FF sty $FE stx
SP X) lda tax OUTCHK jsr
$FE ldx $FF ldy (drop jmp end-code








\ EMIT CR DEL PAGE AT AT?     25JAN85RE)              cas13aug06

| &40 Constant c/row

: 65emit   ( 8b -- ) (emit ;

: 65CR     #CR 65emit ;

: 65DEL    #bs 65emit  SPACE  #bs 65emit ;

: 65PAGE   &125 EMIT ;

: 65at ( row col -- ) $55 ! $54 C! ;

: 65AT?  ( -- ROW COL ) $54 C@ $55 @ ;

\                                                      er14dez88

: 65type ( adr len -- ) bounds ?DO I c@ emit LOOP ;













\ TYPE DISPLAY (BYE       BP  28MAY85RE)              cas09dec05

OUTPUT: DISPLAY   [ HERE OUTPUT ! ]
65EMIT 65CR 65TYPE 65DEL 65PAGE 65AT 65AT? [

\ fix dosini vector and jump through dosvec
| code (bye warmboot 1+ lda  $0C sta  warmboot 2+ lda
$0D sta $000A ) jmp end-code








\ B/BLK                                               cas21dec05

$400 CONSTANT B/BLK

\  definitions for fileinterface

&4 CONSTANT R/O   &8 CONSTANT W/O   &12 CONSTANT R/W
3 CONSTANT IO-OPEN    5 CONSTANT IO-GETREC 7 CONSTANT IO-GETCHR
9 CONSTANT IO-PUTREC $B CONSTANT IO-PUTCHR $C CONSTANT IO-CLOSE

$340 CONSTANT ICFLG  $342 CONSTANT ICCOM  $343 CONSTANT ICSTA
$344 CONSTANT ICBAL  $345 CONSTANT ICBAH  $348 CONSTANT ICBLL
$349 CONSTANT ICBLH  $34A CONSTANT ICAX1  $34B CONSTANT ICAX2
$E456 CONSTANT CIOV


\  definitions for fileinterface                      cas11aug06

label freeiocb0  70 # lda label freeiocb2 tay ICFLG ,y lda
$FF # cmp 0<> ?[ tya sec $10 # sbc freeiocb2 bne ]?
tya rts

code freeiocb freeiocb0 jsr .a lsr .a lsr .a lsr .a lsr pha
push0a jmp end-code

label getfileid sp x) lda .a ASL .a ASL .a ASL .a ASL tay rts

label getparam 2 # ldy  sp )y lda  ICBLL ,x sta
iny  sp )y lda  ICBLH ,x sta
iny  sp )y lda  ICBAL ,x sta
iny  sp )y lda  ICBAH ,x sta
rts
\  definitions for fileinterface                      cas13dec05

code close-file  getfileid jsr tax IO-CLOSE # lda ICCOM ,x sta
CIOV jsr  sp 2inc ICSTA ,x lda  0>= ?[ 0 # lda ]? pha
PUSH0A jmp end-code

code open-file   freeiocb0 jsr tax  IO-OPEN # lda ICCOM ,y sta
4 # ldy  sp )y lda  ICBAL ,x sta
iny  sp )y lda  ICBAH ,x sta
0 # ldy  sp )y lda  ICAX1 ,x sta
tya             ICAX2 ,x sta
CIOV jsr sp 2inc 0 # ldy ICSTA ,x lda  sp )y sta
0>= ?[ 0 # lda sp )y sta ]? 0 # lda tay iny sp )y sta
iny iny sp )y sta txa clc .a lsr .a lsr .a lsr
.a lsr dey sp )y sta xynext jmp end-code

\  definitions for fileinterface                      cas11aug06

code read-file ( caddr u fileid -- u2 ior )
getfileid jsr  tax  getparam jsr
IO-GETCHR # lda  ICCOM ,x sta
CIOV jsr   sp 2inc  0 # ldy
ICSTA ,x lda  sp )y sta
0>= ?[ 0 # lda  sp )y sta ]?  tya iny sp )y sta
clc  iny  ICBLL ,x lda  sp )y sta
iny  ICBLH ,x lda  sp )y sta  xynext jmp end-code






\  definitions for fileinterface                      cas11aug06

code read-line ( caddr u fileid -- u2 flag ior )
getfileid jsr  tax  getparam jsr
IO-GETREC # lda  ICCOM ,x sta
CIOV jsr 0 # ldy
ICSTA ,x lda
0>= ?[ tya ]? sp )y sta
4 # ldy ICBLL ,x lda  sp )y sta
ICBAL ,x adc  tay dey n sty  5 # ldy ICBLH ,x lda sp )y sta
ICBAH ,x adc  n 1+ sta  0 # lda  tay  n )y sta iny
sp )y sta iny sp )y sta iny sp )y sta xynext jmp end-code




\  definitions for fileinterface                      cas11aug06

code write-file ( caddr u fileid -- ior )
getfileid jsr  tax  getparam jsr
IO-PUTCHR # lda  ICCOM ,x sta
CIOV jsr   sp 2inc sp 2inc  0 # ldy
ICSTA ,x lda  sp )y sta
0>= ?[ 0 # lda  sp )y sta ]?
xynext jmp end-code







\  definitions for fileinterface                      cas11aug06
VARIABLE SOURCE-ID  0 SOURCE-ID !
$580 CONSTANT FNBUF
: REFILL tib $50 erase tib $50 SOURCE-ID @ READ-LINE
ROT 1 - #tib ! >in off blk off nip ;
: INCLUDE-FILE ( fileid -- )
SOURCE-ID ! BEGIN REFILL $80 < WHILE INTERPRET REPEAT
SOURCE-ID @ CLOSE-FILE ABORT" File Error" ;
: INCLUDED ( caddr u -- )
SOURCE-ID @  >R   R/O OPEN-FILE DUP $80 < IF DROP
INCLUDE-FILE HERE $50 ERASE #TIB @ >IN ! ELSE
." FileError:" . ABORT THEN R> SOURCE-ID ! ;
: FILE" FNBUF $50 BL FILL HERE $50 BL FILL ASCII " WORD
COUNT FNBUF SWAP CMOVE FNBUF 0 ;
: INCLUDE" ( FNAME ) FILE" INCLUDED ; IMMEDIATE

\                                                     cas21dec05































































