Loadstar - Compleat Programmer

home *** CD-ROM | disk | FTP | other *** search

/ Loadstar - Compleat Programmer / comprog2.d81 / reader.ebud < prev next >

Wrap

Text File | 1990-01-01 | 16.1 KB | 1,580 lines

;loadstar reader source ;4-26-922 by Jeff Jones ;"If you look, don't laugh." open =$ffc0 readst =$ffb7 setlfs =$ffba setnam =$ffbd setmsg =$ff90 load =$ffd5 getin =$ffe4 input'buffer =512 clrchn =$ffcc close =$ffc3 ;a chrin =$ffcf chkout =$ffc9 ;x chkin =$ffc6 ;x plot =$fff0 chrout =$ffd2 color'pointer =243 screen'line'pointer =209 print'number =$bdcd ;x,a clear'line =59903 background =53281 border =53280 strout = $ab1e; .A low .Y high unlisten =$ffae clall =$ffe7 color1 =53282 color2 =53283 color3 =53284 white =5 crsr'down =17 rvs'on =18 home =19 del =20 red =28 crsr'right =29 green =30 blue =31 black =144 lowercase =14 uppercase =142 crsr'up =145 rvs'off =146 clr =147 insert =148 brown =149 light'red =150 dark'grey =151 medium'grey =152 light'green =153 light'blue =154 light'grey =155 purple =156 crsr'left =157 yellow =158 cyan =159 top'left =176 top'right =174 bottom'left =173 bottom'right =189 .org $c000 .obj "@0:reader c000" .mem jmp load'file;27 jmp box'entry;; 3 jmp linx; 12 jmp print'at;15 jmp center;18 jmp read'existing;30 jmp bload;51 jmp frame'entry;54 jmp get'scroll'up;57 jmp get'scroll'down;60 jmp clear'row;63 ;sys,addr y,x1,x2,number items,text,highlight,esc ;***sys addr,x,to x,y,to y,s-code,color box'entry lda #5 sta parm'count box'ii lda #0 sta temp - jsr get'number tya ldy temp sta box'parameters,y inc temp cpy parm'count bne - fill'box jsr linx lda 214 pha lda 211 pha box'start ldx box'parameters+2 ldy #0 clc jsr $fff0 jsr old'rom'patch dec box'parameters ;inc box'parameters+3 - ldy box'parameters+1 - lda box'parameters+4 cmp #255 beq + sta (209),y + lda box'parameters+5 store'color sta (243),y dey cpy box'parameters bne - lda 214 cmp box'parameters+3 beq + inc 214 jsr 58732 jsr old'rom'patch jmp -- + lda #home jsr $ffd2 pla sta 211 pla sta 214 jmp 58732 linx ldy #24 - lda 217,y ora #128 sta 217,y dey bpl - rts ;**** get number from BASIC **** get'number jsr $aefd jsr $ad8a jmp $b7f7 ;***** get string from BASIC **** get'string jsr $aefd jsr $ad9e jsr $b6a3 ldx $22 ldy $23 rts print'at jsr linx jsr get'number sty 211 jsr get'number sty 214 jsr 58732 jsr get'string sta temp print'string lda temp beq + ldy #0 - lda ($22),y jsr chrout iny cpy temp bne - + rts center jsr get'number tya tax ldy #0 clc jsr plot jsr get'string mcenter sta temp lsr sta flag lda #20 sec sbc flag sta 211 jsr 58732 jmp print'string old'rom'patch lda 210 sec sbc 648 clc adc #$d8 sta 244 lda 209 sta 243 rts bload jsr get'string jsr setnam jsr get'number tya tax lda #2 ldy #0 jsr setlfs jsr get'number sty base sta base+1 ldx $14 ldy $15 lda #0 jmp load do'box stx 251 sty 252 ldy #5 - lda (251),y sta box'parameters,y dey bpl - jmp fill'box do'frame stx 251 sty 252 ldy #4 - lda (251),y sta box'parameters,y dey bpl - jmp frame'up frame'entry lda #4 sta parm'count frame'ii lda #0 sta temp - jsr get'number tya ldy temp sta box'parameters,y inc temp cpy parm'count bne - frame'up jsr linx lda 214 pha lda 211 pha frame'start ldx box'parameters+2 ldy #0 clc jsr plot jsr old'rom'patch ;dec box'parameters ldy box'parameters+1 lda box'parameters+4 pha and #128 ora #110 sta (209),y pla sta (243),y dey - lda box'parameters+4 pha and #128 ora #64 sta (209),y pla sta (243),y dey cpy box'parameters bne - lda box'parameters+4 pha and #128 ora #112 sta (209),y pla sta (243),y - lda #13 jsr chrout jsr old'rom'patch lda 214 cmp box'parameters+3 bcs do'bottom lda box'parameters+4 pha and #128 ora #93 ldy box'parameters sta (209),y ldy box'parameters+1 sta (209),y pla sta (243),y ldy box'parameters sta (243),y jmp - do'bottom ldy box'parameters+1 lda box'parameters+4 pha and #128 ora #125 sta (209),y pla sta (243),y dey - lda box'parameters+4 pha and #128 ora #64 sta (209),y pla sta (243),y dey cpy box'parameters bne - lda box'parameters+4 pha and #128 ora #109 sta (209),y pla sta (243),y pla sta 211 pla sta 214 jsr 58732 jmp linx zero'stash ldy #9 - lda 245,y sta zero'buf,y dey bpl - rts zero'restore ldy #9 - lda zero'buf,y sta 245,y dey bpl - rts read'existing jsr get'number sty 174 sta 175 sty base sta base+1 ldy #0 sei lda #$74 sta 1 - lda (174),y bne + beq ++ + inc 174 bne - inc 175 jmp - + lda 174 sta eof lda 175 sta eof+1 lda #$77 sta 1 cli lda #0 jmp + load'file jsr bload stx eof sty eof+1 + ldy #0 sty setup'flag tya sta (174),y sta bottom'flag lda #147 jsr chrout lda #32 sta text'color-1 jsr get'number sty text'color sty top'frame'color tya and #128 ora text'color-1 sta text'color-1 jsr get'number sty frame'color sty top'box'color jsr count'lines setup lda #0 sta bottom'flag ldx <frame'parms ldy >frame'parms jsr do'frame ldx <top'frame'parms ldy >top'frame'parms jsr do'frame lda top'box'color sta 646 and #128 sta 199 bit setup'flag bmi + lda top'box'parms+4 ora 199 sta top'box'parms+4 ldx <top'box'parms ldy >top'box'parms jsr do'box ldx #2 ldy #0 clc jsr plot jsr get'string jsr mcenter + lda #255 sta setup'flag ldx <text'parms ldy >text'parms jsr do'box ldx frame'parms+3 inx jsr 59903 ldx frame'parms+3 inx ldy #5 clc jsr plot lda frame'parms+4 sta 646 lda <line'text ldy >line'text jsr strout ldx #18 stx 211 jsr 58732 lda text'parms+5 sta 646 ldx line'count lda line'count+1 jsr print'number lda frame'parms+4 sta 646 inc 214 lda #1 sta 211 jsr 58732 lda <lil'menu ldy >lil'menu jsr strout inc 214 lda #8 sta 211 jsr 58732 lda <lil'too ldy >lil'too jsr strout ldx 214 dex ldy #1 clc jsr plot jsr old'rom'patch ldy #80 - lda (209),y bpl + and #127 sta (209),y lda text'parms+5 sta (243),y + dey bpl - lda base sta 251 lda base+1 sta 252 lda #0 sta text'loc sta text'loc+1 sta cur'line sta cur'line+1 inc cur'line lda cur'line jsr page jsr print'line'no get'text'key jsr getin beq get'text'key cmp #17 bne + jsr text'down jsr print'line'no jmp get'text'key + cmp #145 bne + jsr text'up jsr print'line'no jmp get'text'key + cmp #19 bne + jmp setup + cmp #crsr'right bne + jmp page'down + cmp #crsr'left bne + jmp page'up + cmp #147 bne + jsr move'bottom jsr print'line'no jmp get'text'key + cmp "q" bne + rts + cmp "p" bne get'text'key jsr print'text jmp setup text'down lda bottom'flag beq + rts + jsr zero'stash ldx <text'parms ldy >text'parms jsr do'scroll'down inc cur'line bne + inc cur'line+1 + jmp zero'restore do'scroll'down stx 251 sty 252 ldy #3 - lda (251),y sta startingx,y dey bpl - jsr scroll'up lda text'color-1 sta char lda text'color sta color jsr clear'ii print'new'bottom'line lda text'loc sta 251 lda text'loc+1 sta 252 jsr page'loop jsr rom'out ldy #0 lda box'top sta 251 lda box'top+1 sta 252 lda text'color and 3128 sta 199 - lda (251),y cmp #13 beq nbo inc 251 bne + inc 252 + jmp - nbo lda 251 sta box'top lda 252 sta box'top+1 jmp rom'in page lda text'color sta 646 and #128 sta 199 ldy text'parms ldx text'parms+2 clc jsr plot page'loop ldy #0 - jsr rom'out lda (251),y jsr bump'251 cmp #0 beq hit'bottom jsr rom'in jsr chrout lda 211 bne - lda text'color and #128 sta 199 lda #29 jsr chrout lda 214 cmp frame'parms+3 bcs + jmp - / lda 251 sta text'loc lda 252 sta text'loc+1 rts hit'bottom jsr rom'in lda #1 sta bottom'flag jmp - page'down lda #14 sta wordbuf - lda #0 sta 199 jsr text'down dec wordbuf bpl - jsr print'line'no jmp get'text'key page'up lda #14 sta wordbuf - jsr text'up lda cur'line+1 bne + lda cur'line cmp #1 beq ++ + dec wordbuf bpl - + jsr print'line'no jmp get'text'key rom'out pha sei lda #$74 sta 1 pla rts rom'in pha lda #$77 sta 1 cli pla rts bump'251 inc 251 bne + inc 252 + rts get'scroll'up jsr get'scroll'parms jmp scroll'up get'scroll'down jsr get'scroll'parms jmp scroll'down get'scroll'parms lda #0 sta temp - jsr get'number tya ldx temp sta startingx,x inc temp inx cpx #4 bcc - rts scroll'up ldy startingx ldx startingy stx line clc jsr plot jsr old'rom'patch scroll'up'math clc lda 209 adc <40 sta 251 lda 210 adc >40 sta 252 clc lda 243 adc <40 sta 253 lda 244 adc >40 sta 254 ldy startingx - lda (251),y sta (209),y lda (253),y sta (243),y iny cpy endingx beq - bcc - inc line lda line cmp endingy bcs through'scrolling'up clc lda 209 adc <40 sta 209 lda 210 adc >40 sta 210 clc lda 243 adc <40 sta 243 lda 244 adc >40 sta 244 jmp scroll'up'math through'scrolling'up ldx endingy ldy startingx clc jsr plot jmp old'rom'patch scroll'down ldy startingx ldx endingy stx line clc jsr plot jsr old'rom'patch scroll'down'math sec lda 209 sbc <40 sta 251 lda 210 sbc >40 sta 252 sec lda 243 sbc <40 sta 253 lda 244 sbc >40 sta 254 ldy startingx - lda (251),y sta (209),y lda (253),y sta (243),y iny cpy endingx beq - bcc - dec line lda line cmp startingy beq through'scrolling'down sec lda 209 sbc <40 sta 209 lda 210 sbc >40 sta 210 sec lda 243 sbc <40 sta 243 lda 244 sbc >40 sta 244 jmp scroll'down'math through'scrolling'down ldx startingy ldy startingx clc jsr plot jmp old'rom'patch clear'row jsr get'number sty char jsr get'number sty color clear'ii ldy startingx - lda char sta (209),y lda color sta (243),y iny cpy endingx beq - bcc - rts text'up jsr zero'stash lda cur'line+1 bne ++ lda cur'line cmp #1 beq + bcs ++ + lda base sta 251 lda base+1 sta 252 jmp page + sec lda cur'line sbc #1 sta cur'line lda cur'line+1 sbc #0 sta cur'line+1 lda cur'line+1 bne + lda cur'line cmp #1 bne + ldx <text'parms ldy >text'parms jsr do'box lda base sta 251 lda base+1 sta 252 jmp page + ldx <text'parms ldy >text'parms jsr do'scroll'up jmp zero'restore do'scroll'up stx 251 sty 252 ldy #3 - lda (251),y sta startingx,y dey bpl - jsr scroll'down lda #0 sta bottom'flag lda text'color-1 sta char lda text'color sta color jsr clear'ii count'back lda #0 sta temp lda text'loc sta 251 lda text'loc+1 sta 252 ldy #0 - dec 251 lda 251 cmp #255 bne + dec 252 + jsr rom'out lda (251),y jsr rom'in beq + cmp #13 bne - + inc temp lda temp cmp #2 bne + jsr bump'251 lda 251 sta text'loc lda 252 sta text'loc+1 jmp - + cmp #18 bne - top'line inc 251 bne + inc 252 + jsr rom'in print'new'top lda text'color sta 646 and #128 sta 199 ;ldy text'parms ;ldx text'parms+2 ;clc ;jsr plot ldy #0 - jsr rom'out lda (251),y beq suo jsr bump'251 jsr rom'in jsr chrout lda 211 bne - suo jmp rom'in print'line'no sec jsr plot stx menuy sty menux1 ldx frame'parms+3 inx ldy #32 clc jsr plot ldy #32 lda text'color-1 - sta (209),y iny cpy #38 bne - lda #0 sta 199 ldx cur'line lda cur'line+1 jsr print'number clc ldx menuy ldy menux1 jmp plot count'lines jsr zero'stash lda #0 sta line'count sta line'count+1 lda base sta 251 lda base+1 sta 252 ldy #0 jsr rom'out - lda (251),y beq count'done inc 251 bne + inc 252 + cmp #13 bne - inc line'count bne - inc line'count+1 jmp - count'done jsr rom'in lda line'count sec sbc #13 sta line'count lda line'count+1 sbc #0 sta line'count+1 jmp zero'restore move'bottom lda eof sta 251 sta text'loc lda eof+1 sta 252 sta text'loc+1 lda #0 sta temp ldy #0 - dec 251 lda 251 cmp #255 bne + dec 252 + jsr rom'out lda (251),y jsr rom'in beq + cmp #13 bne - + inc temp lda temp cmp #2 bne + jsr bump'251 lda 251 sta text'loc lda 252 sta text'loc+1 jmp - + cmp #16 bne - jsr bump'251 jsr rom'in lda 252 cmp base+1 beq + bcs ++ + lda 251 cmp base bcs + lda base sta 251 lda base+1 sta 252 + jsr zero'stash ldx <text'parms ldy >text'parms jsr do'box jsr zero'restore jsr page lda line'count sta cur'line lda line'count+1 sta cur'line+1 jmp zero'stash print'text ldx <text'parms ldy >text'parms jsr do'box lda text'color and #128 sta 199 ldx text'parms+2 inx inx ldy #1 clc jsr plot lda <tractor'prompt ldy >tractor'prompt jsr strout lda #1 sta pageno sta pageno+1 - jsr getin beq - and #127 cmp "s" beq do'normal'print cmp "t" beq do'normal'print cmp "q" beq + bne - + rts do'normal'print sta print'mode inc 214 inc 214 lda #3 sta 211 jsr 58732 lda <formfeed'prompt ldy >formfeed'prompt jsr strout - jsr getin beq - and #127 cmp "q" bne + rts + cmp "y" beq + cmp "n" beq + jmp - + sta formfeed'mode lda base sta 249 lda base+1 sta 250 jsr do'printing'prompt lda #0 jsr setnam ldx #4 lda #4 ldy #7 jsr setlfs jsr open jsr clrchn ldx #4 jsr chkout lda #1 sta pos sta wordlen sta endpflag sta retcount inc retcount lda #" " ldx #4 stx p'line jsr repeat jsr leftmrgn ;position printer jsr setprt heregoes jsr findword ;find a word jsr printwrd ;print the word jsr advcntr ;advance hi/lo pointer ldx 197 cpx #10 beq formfeed ldx endpflag bpl heregoes;if not end then loop formfeed lda formfeed'mode cmp "n" beq + lda #12 jsr chrout jmp bailout + lda #13 jsr chrout inc p'line lda p'line cmp #64 bcc formfeed lda pageno cmp #2 bcc bailout lda #" " ldx #38 jsr repeat lda #"-" jsr chrout lda #0 ldx pageno jsr $bdcd lda #"-" jsr chrout bailout lda #13 ldx #6 jsr repeat lda #4 jsr close:dec 154 lda #19 sta 631 lda #1 sta 198 rts repeat jsr chrout dex bne repeat rts leftmrgn lda #13 jsr chrout ldx #10:stx pos lda #" " jsr repeat inc p'line ldx p'line cpx #61 beq + jmp notyet + lda formfeed'mode cmp "n" beq + lda #12 jsr chrout lda 249 sta tempoint lda 250 sta tempoint+1 sty tempy ldx #5 lda #13 jmp npage + lda #13 jsr chrout jsr chrout jsr chrout ldx pageno cpx #2 bcc snick lda 249 sta tempoint lda 250 sta tempoint+1 sty tempy lda #" " ldx #38 jsr repeat lda #"-" jsr chrout ldx pageno lda #0 jsr $bdcd lda #"-" jsr chrout ldy tempy lda tempoint sta 249 lda tempoint+1 sta 250 snick ldx #7 lda #13 npage jsr chrout dex bne npage pagewait lda print'mode cmp "t" beq newpage jsr do'sheet'prompt jsr do'printing'prompt newpage lda #5 sta p'line lda #" " ldx #10 stx pos jsr repeat inc pageno notyet rts setprt lda base sta 249 lda base+1 sta 250 rts findword ldy #0 lda 1 and #254 sta 1 fw1 jsr rom'out lda (249),y jsr rom'in bne nonzero ldx #129 stx endpflag nonzero sta wordbuf,y notret and #95 ;32 or 160 will zero beq aha ;found a space or shift cpy #41 beq aha ;word buffer is full iny bne fw1 aha clc lda 1 ora #1 sta 1 tya sta wordlen adc pos cmp #76 ;right margin bcc short jsr leftmrgn short rts printwrd ldy #0 inc wordlen ptwd1 lda wordbuf,y iny ldx wordbuf,y dey stx nchar jsr checkrt cmp #0 beq ptwd2 jsr chrout inc pos ptwd2 iny cpy wordlen bne ptwd1 dec wordlen rts incprt inc 249 bne inprtout inc 250 inprtout rts decprt dec 249 bne deprtout dec 250 deprtout rts zeroret ldx #2 stx retcount rts checkrt cmp #13 beq checkrt1 jmp zeroret checkrt1 ldx nchar cpx #32 beq checksp2 cpx #13 beq checkrt3 checkrt2 dec retcount beq checkrt3 lda #" " rts checkrt3 jsr zeroret jsr leftmrgn lda #0 rts checksp2 jsr leftmrgn lda #" " rts advcntr ldy wordlen advcntr1 jsr incprt dey bpl advcntr1 rts do'sheet'prompt pha tya pha txa pha lda 53280 sta menuy ldx <text'parms ldy >text'parms jsr do'box lda text'color and #128 sta 251 ldx text'parms+2 inx inx ldy #11 clc jsr plot ldy #11 ldx #0 - lda sht,x beq + ora 251 sta (209),y iny inx bne - / inc 53280 lda 197 cmp #64 beq - lda #0 sta 198 pla tay pla tax pla lda menuy sta 53280 rts do'printing'prompt pha tya pha txa pha ldx <text'parms ldy >text'parms jsr do'box lda text'color and #128 sta 251 ldx text'parms+2 inx inx ldy #11 clc jsr plot ldy #9 ldx #0 - lda prt,x beq + ora 251 sta (209),y iny inx bne - + pla tay pla tax pla rts sht .scr "Next Sheet/Any Key":.byt 0 prt .scr "P R I N T I N G . . .":.byt 0 ;print'method .byt 0 no'print .byt 0 column .byt 0,0 prlen .byte 0,0 prloc .byte 0,0 pos .byte 0 p'line .byte 0 wordlen .byte 0 wordbuf .buf 42 retcount .byte 1 endpflag .byte 1 nchar .byte 1 pageno .byt 0,0 tempoint .byte 0,0 tempy .byte 0 print'mode .asc "t" zero'buf .buf 10 menuy .byt 0 menux1 .byt 0 menux2 .byt 0 menu'current .byt 0 mcolor .byt 0 parm'count .byt 0 box'parameters .buf 6 flag .byt 0 temp .byt 0 base .word 0 text'parms .byt 1,38,5,19,160 text'color .byt 3 frame'parms .byt 0,39,4,20 frame'color .byte 0 top'frame'parms .byt 0,39,1,3 top'frame'color .byt 0 top'box'parms .byte 1,38,2,2,32 top'box'color .byt 0 setup'flag .byt 0 startingx .byt 0 endingx .byt 0 startingy .byt 0 endingy .byt 0 char .byt 0 color .byt 0 line .byt 0 page'mode .byt 0 text'loc .buf 2 box'top .buf 2 bottom'flag .byt 0 bottom'one .buf 2 cur'line .word 0 line'text .asc "Total Lines: Current: ":.byt 0 lil'menu .byt 18:.asc "Up/Down":.byt 146:.asc " - Scroll ":.byt 18:.asc "HOME/CLR":.byt 146:.asc " - Top/Bottom":.byt 0 lil'too .byt 18:.asc "P":.byt 146:.asc " - Print ":.byt 18:.asc "Q":.byt 146:.asc " - Quit Text":.byte 0 line'count .word 0 tractor'prompt .asc "Single sheet or Tractor feed? (S/T/Q)":.byt 0 eof .word 0 formfeed'prompt .asc "Use form feed on each page? (Y/N)":.byt 0 formfeed'mode .byt 1 .end