(local {: vm : org} (require :bitsy.defs)) (local {: hi : lo} (require :lib.util)) (vm:def :draw-pchar ; pscreen pchar -- [:block [:ldy 7] [:clc] :loop [:lda [vm.TOP :x]] [:sta [vm.ST1 :x]] [:inc vm.TOP :x] [:lda vm.ST1H :x] [:adc 4] [:sta vm.ST1H :x] [:dey] [:bne :loop] ] (vm:drop) (vm:drop)) (vm:def :lookup-pchar ; c -- pchar [:sec] [:lda vm.TOP :x] [:sbc 0x20] [:sta vm.TOP :x] [:lda 0] [:asl vm.TOP :x] [:rol :a] ;x2 [:asl vm.TOP :x] [:rol :a] ;x4 [:asl vm.TOP :x] [:rol :a] ;x8 [:adc #(hi ($1:lookup-addr :font))] [:sta vm.TOPH :x]) (vm:word :draw-char ; pscreen c -- :lookup-pchar :draw-pchar) (vm:word :draw-digit ; pscreen n -- 0x30 :+ :draw-char) (vm:word :snooze (vm:for)) (vm:word :textsnooze 0x30 :snooze) (vm:word :draw-text1 0x2257 :draw-text) (vm:word :draw-text2 0x22d7 :draw-text) (vm:word :draw-text3 0x2357 :draw-text) (vm:word :draw-text4 0x23d7 :draw-text) (vm:word :draw-text ; st pscreen -- (vm:while [:over :bget :dup] ; st pscreen c :over :swap :draw-char ; st pscreen :textsnooze :inc :swap :inc :swap) :drop :drop :drop) (vm:word :cleartext 0x2257 :clearline 0x22d7 :clearline 0x2357 :clearline 0x23d7 :clearline) (vm:word :wait-for-return (vm:until :read-key (string.byte "\r") :=)) (vm:word :dismiss-dialog :wait-for-return :cleartext) (vm:var :footer-displayed vm.false) (vm:word :show-footer :footer-displayed :get :not (vm:when vm.true :footer-displayed :set :drawfooter)) (vm:word :hide-footer :footer-displayed :get (vm:when vm.false :footer-displayed :set :clearfooter))