'- this code still has bugs to be fixed on the attribute area, related with system variables

dim iq as uinteger
'-
function adr64x32(x0,y0,l0 as ubyte)
  return (32768+((y0*6+l0)*32)+int(x0/2))
  end function

dim maskanddsp,maskandchm,rtv,u1,u2,u1i,u2i,vq,adqv,adqvn,v1,v5,v6,adraq as ubyte
dim adq as uinteger
'-
sub putchar64x32(x1,y1,c1 as ubyte)
  'for iq=0 to 5 step 5:
    '- previous version - only using attributes from 22528
    'poke 22528+int(x1/2)+(int(((y1*6)+iq)/8))*32,peek(23693)
    '- version for supporting colours 8 and 9
    ' adraq=22528+int(x1/2)+(int(((y1*6)+iq)/8))*32
    ' v1=peek(adraq)
    ' v5=(v1 band peek(23694)) bor (peek(23693) band (255-peek(23694))):v6=v5   :'- colour 8
    ' if (peek (23697) band 16)<>0 then:v6=(v5 band 248) bor ((1-(v5 band 32)/32)*7):end if :'- colour 9 - ink
    ' if (peek (23697) band 64)<>0 then:v6=(v5 band 199) bor ((1-(v5 band 4)/4)*56):end if  :'- colour 9 - paper
    ' poke adraq,v6
    'next iq
  maskanddsp=15*(1+15*((x1 band 1)))
  maskandchm=15*(1+15*(1-(c1 band 1)))
  c2=(int(c1/2))-16
  rtv=0
  if (c1 band 1)>(x1 band 1) then:
    rtv=1:end if '- /16
  if (c1 band 1)<(x1 band 1) then:
    rtv=2:end if '- *16
  for yq=0 to 5
    u1=peek(@p64x32charset+yq+(c2*6))
    u1i=255-u1
    u2=u1 band maskandchm
    u2i=u1i band maskandchm
    if rtv=1 then:u2=int(u2*16):end if
    if rtv=2 then:u2=int(u2/16):end if
    adq=adr64x32(x1,y1,yq)
    adqv=peek(adq)
    adqvn=255-adqv
    '- vq=(peek(adq) band maskanddsp) bor u2

    'if (peek(23697) band 5)=0 then:  vq=(adqv band maskanddsp) bor u2 : end if
    'if (peek(23697) band 4)<>0 then: vq=(adqv band maskanddsp) bor u2i : end if :'- bug on inverse?
    'if (peek(23697) band 1)<>0 then: vq=adqv bxor u2 : end if                   :'- over ok 

    poke adq,vq
    next
  end sub

dim i3,e3 as ubyte
'-
sub print64x32at(x2 as ubyte,y2 as ubyte,text$ as string)
  
  for i3=0 to len(text$)-1
    e3=code(text$(i3))
    putchar64x32((x2+i3)band 63,y2+int((x2+i3)/64),e3)
    next i3
  end sub

goto lp01

'-------------------------

p64x32charset:
asm
  defb 004h,004h,004h,000h,004h,000h ; space !
  defb 0aah,0aeh,00ah,00eh,00ah,000h ; "" #
  defb 04ah,0e2h,0c4h,068h,0eah,040h ; $ %
  defb 0c4h,0c4h,060h,0c0h,0e0h,000h ; & '
  defb 044h,082h,082h,082h,044h,000h ; ( )
  defb 040h,0e0h,0a4h,00eh,004h,000h ; * +
  defb 000h,000h,000h,00eh,040h,080h ; , -
  defb 002h,002h,004h,008h,048h,000h ; . /
  defb 044h,0ach,0a4h,0a4h,04eh,000h ; 0 1
  defb 0cch,022h,044h,082h,0ech,000h ; 2 3
  defb 06eh,0a8h,0ach,0e2h,02ch,000h ; 4 5
  defb 06eh,082h,0c2h,0a4h,044h,000h ; 6 7
  defb 044h,0aah,046h,0a2h,044h,000h ; 8 9
  defb 000h,000h,044h,000h,044h,008h ; : ;
  defb 000h,000h,04eh,080h,04eh,000h ; < =
  defb 00ch,002h,044h,020h,044h,000h ; > ?
  defb 044h,0aah,0eah,08eh,06ah,000h ; @ A
  defb 0c4h,0aah,0c8h,0aah,0c4h,000h ; B C
  defb 0ceh,0a8h,0ach,0a8h,0ceh,000h ; D E
  defb 0e6h,088h,0cah,08ah,086h,000h ; F G
  defb 0aeh,0a4h,0e4h,0a4h,0aeh,000h ; H I
  defb 02ah,02ch,02ch,0aah,04ah,000h ; J K
  defb 08ah,08eh,08eh,08eh,0eeh,000h ; L M
  defb 0a4h,0eah,0eah,0eah,0a4h,000h ; N O
  defb 0c4h,0aah,0aah,0ceh,086h,000h ; P Q
  defb 0c6h,0a8h,0a4h,0c2h,0ach,000h ; R S
  defb 0eah,04ah,04ah,04ah,04eh,000h ; T U
  defb 0aah,0aah,0aeh,0eeh,04ah,000h ; V W
  defb 0aah,0aah,04eh,0a4h,0a4h,000h ; X Y
  defb 0eeh,028h,048h,088h,0eeh,000h ; Z [
  defb 08eh,082h,042h,022h,02eh,000h ; \ ]
  defb 040h,0a0h,000h,000h,00eh,000h ; ^ _
  defb 080h,04ch,002h,00eh,00eh,000h ; ? a
  defb 080h,0c6h,0a8h,0a8h,0c6h,000h ; b c
  defb 020h,064h,0aeh,0a8h,066h,000h ; d e
  defb 020h,046h,0eah,046h,042h,00ch ; f g
  defb 084h,0c0h,0ach,0a4h,0aeh,000h ; h i
  defb 048h,00ah,0cch,04ah,04ah,080h ; j k
  defb 0c0h,04ch,04eh,04eh,0eeh,000h ; l m
  defb 000h,0c4h,0aah,0aah,0a4h,000h ; n o
  defb 000h,0c6h,0aah,0aah,0c6h,082h ; p q
  defb 000h,0a6h,0cch,082h,08ch,000h ; r s
  defb 040h,0eah,04ah,04ah,026h,000h ; t u
  defb 000h,0aah,0aeh,0eeh,04eh,000h ; v w
  defb 000h,0aah,04ah,0a6h,0a2h,00ch ; x y
  defb 006h,0e4h,04ch,084h,0e6h,000h ; z {
  defb 04ch,044h,046h,044h,04ch,000h ; | }
  defb 060h,0c0h,000h,000h,000h,000h ; ~ (c)
  end asm

lp01:


