mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-06-01 06:41:37 +00:00
1 line
19 KiB
Plaintext
Executable File
1 line
19 KiB
Plaintext
Executable File
\ loadscreen fuer EMUF i/o cas09dec05 1 &14 +thru \ 65KEY? GETKEY 25JAN85RE) cs08aug05 | $02FC Constant CH | CODE 65KEY? ( -- FLAG) CH lda clc 1 # adc push0a jmp end-code | CODE G1 LABEL GETCHK $E425 lda pha $E424 lda pha rts end-code | CODE GETKEY ( -- 8B) $FF sty $FE stx GETCHK jsr $FE ldx $FF ldy push0a jmp end-code | $02F0 Constant CRSINH | CODE CURON ( --) 01 # lda CRSINH sta NEXT JMP END-CODE | CODE CUROFF ( --) 00 # lda CRSINH sta NEXT JMP END-CODE : 65KEY ( -- 8B) CURON BEGIN PAUSE 65KEY? UNTIL CUROFF GETKEY ; \ DECODE EXPECT KEYBOARD BP28MAY85) cs08aug057E 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 ) cs09aug05 | Code O1 LABEL OUTCHK $E407 lda pha $E406 lda pha txa rts end-code 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) cs09aug05 | Variable out 0 out ! | &40 Constant c/row : 65emit ( 8b -- ) 1 out +! (emit ; : 65CR #CR 65emit out @ c/row / 1+ c/row * out ! ; : 65DEL #bs 65emit SPACE #bs 65emit -2 out +! ; : 65PAGE .( page einf. ) out off ; : 65at ( row col -- ) .( at einf. ) swap c/row * + out ! ; : 65AT? ( -- ROW COL ) out @ c/row /mod &24 min swap ; \ 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 DRIVE >DRIVE DRVINIT 28MAY85RE) cas21dec05 $400 CONSTANT B/BLK \\ $0AA CONSTANT BLK/DRV | VARIABLE (DRV 0 (DRV ! | : DISK ( -- DEV.NO ) (DRV @ 8 + ; : DRIVE ( DRV# -- ) BLK/DRV * OFFSET ! ; \\ cas21dec05: >DRIVE ( BLOCK DRV# -- BLOCK' ) BLK/DRV * + OFFSET @ - ; : DRV? ( BLOCK -- DRV# ) OFFSET @ + BLK/DRV / ; : DRVINIT NOOP ; .( fuer reads. u. writes. ist errorhandler erforderlich ) | : readserial ( adr blk -- ) &27 emit .( rb ) space base push decimal . cr $400 bounds DO key I c! LOOP ; | : writeserial ( adr blk -- ) &27 emit .( wb ) space base push decimal . cr $400 bounds DO I c@ emit LOOP ; \\ (r/w cas21dec05 : (R/W ( ADR BLK FILE R/WF -- FLAG) swap abort" no file" IF readserial ELSE writeserial THEN false ; ' (R/W IS R/W \ definitions for fileinterface cas09dec05 &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 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 \ 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 cas09dec05 code read-file ( caddr u fileid -- u2 ior ) getfileid jsr tax 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 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 cas09dec05 code read-line ( caddr u fileid -- u2 flag ior ) getfileid jsr tax 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 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 cas13dec05VARIABLE SOURCE-ID 0 SOURCE-ID ! $580 CONSTANT FNBUF : REFILL tib $50 SOURCE-ID @ READ-LINE ROT 1 - #tib ! >in off blk off nip ; : TIBSAVE #TIB @ $FE ! >in @ $FC ! FNBUF >tib ! ; : TIBREST $FC @ >in ! $FE @ #tib ! $100 >tib ! ; : INCLUDE-FILE ( fileid -- ) SOURCE-ID ! BEGIN REFILL $80 < WHILE INTERPRET REPEAT SOURCE-ID @ CLOSE-FILE ; : INCLUDED ( caddr u -- ) R/O OPEN-FILE $80 < IF TIBSAVE INCLUDE-FILE 0 SOURCE-ID ! TIBREST THEN ; : FILE" FNBUF $50 BL FILL HERE $50 BL FILL ASCII " WORD COUNT FNBUF SWAP CMOVE FNBUF 0 ; : INCLUDE" ( FNAME ) FILE" INCLUDED ; IMMEDIATE |