Black Box 4/BlackBox.cdr/progbas/hgclib.arj/HGCLIB.BAS

BASIC Source File | 1991-03-29 | 3.0 KB | 166 lines

sub const
 %index=&h03b4
 %cntrl=&h03b8
 %config=&h03bf
 %scr.on=&h08
 %pageseg=&hb800
end sub

sub htext
 rem set mode to full
 out %config,3
 rem set to text
 out %cntrl,0
 rem initialise the 6845
 out %index,0
 out %index+1,97
 out %index,1
 out %index+1,80
 out %index,2
 out %index+1,82
 out %index,3
 out %index+1,15
 out %index,4
 out %index+1,25
 out %index,5
 out %index+1,6
 out %index,6
 out %index+1,25
 out %index,7
 out %index+1,25
 out %index,8
 out %index+1,2
 out %index,9
 out %index+1,13
 out %index,10
 out %index+1,&h0d
 out %index,11
 out %index+1,&h0c
 rem turn display on page 0
 out %cntrl,&h28
end sub

sub hgraph
 rem set mode to full
 out %config,3
 rem set graphics with screen off
 out %cntrl,2
 rem initialise the 6845
 out %index,0
 out %index+1,&h35
 out %index,1
 out %index+1,&h2d
 out %index,2
 out %index+1,&h2e
 out %index,3
 out %index+1,&h07
 out %index,4
 out %index+1,&h5b
 out %index,5
 out %index+1,&h02
 out %index,6
 out %index+1,&h57
 out %index,7
 out %index+1,&h57
 out %index,8
 out %index+1,&h02
 out %index,9
 out %index+1,&h03
 out %index,10
 out %index+1,&h00
 out %index,11
 out %index+1,&h00
 rem screen on page 1
 out %cntrl,10+128
end sub

sub hclr
 def seg=%pageseg
 for i%=0 to &h7fff-361
  poke i%,&h00
 next i%
end sub

sub hpset(x%,y%,c%)
 def seg=%pageseg
 if x%<0 or x%>719 then exit sub
 if y%<0 or y%>347 then exit sub
 a%=&h2000*(y% mod 4)+90*(y%\4)+x%\8
 b%=7-(x% mod 8)
 m%=exp2(b%)
 d%=peek(a%)
 if c%=0 then d%=d% and (not m%) else d%=d% or m%
 poke a%,d%
end sub

sub hline(x1%,y1%,x2%,y2%,c%)
 if x1%>x2% then swap x1%,x2%:swap y1%,y2%
 if abs(y2%-y1%)<(x2%-x1%) then
  s=(y2%-y1%)/(x2%-x1%)
  y=y1%
  for x%=x1% to x2%
   y%=int(y)
   call hpset(x%,y%,c%)
   y=y+s
  next x%
 else
  s=(x2%-x1%)/(y2%-y1%)
  x=x1%
  for y%=y1% to y2%
   x%=int(x)
   call hpset(x%,y%,c%)
   x=x+s
  next y%
 end if
end sub

sub hbox(x1%,y1%,x2%,y2%,c%)
 if x1%>x2% then swap x1%,x2%
 for x%=x1% to x2%
  call hpset(x%,y1%,c%)
  call hpset(x%,y2%,c%)
 next x%
 if y1%>y2% then swap y1%,y2%
 for y%=y1% to y2%
  call hpset(x1%,y%,c%)
  call hpset(x2%,y%,c%)
 next y%
end sub

sub hcircle(a%,b%,r%,e,c%)
 inc=1/r%
 ic=cos(inc):is=sin(inc)
 x=r%:y=0
 call hpset(a%-int(x),b%+int(y*e),c%)
 call hpset(a%+int(x),b%+int(y*e),c%)
 for t=0 to 3.14156/2 step inc
  z=x
  x=x*ic-y*is
  y=z*is+y*ic
  call hpset(a%+int(x),b%+int(y*e),c%)
  call hpset(a%-int(x),b%+int(y*e),c%)
  call hpset(a%+int(x),b%-int(y*e),c%)
  call hpset(a%-int(x),b%-int(y*e),c%)
 next t
end sub

sub hprint(r%,c%,s$)
 if len(s$)=0 then exit sub
 if r%>33 then exit sub
 for j%=1 to len(s$)
  ch%=asc(mid$(s$,j%,1))
  p%=ch%*8
  l%=r%*10
  for i%=0 to 7
   def seg=&hf000
   b%=peek((&hfa6e+p%+i%))
   rem def seg=%pageseg
   rem b%=peek(&hfa6e+p%+i%))
   def seg=%pageseg
   a%=&h2000*((l%+i%) mod 4)+((l%+i%)\4)*90+c%+j%-1
   if a%<&h7fff-361 then poke a%,b%
  next i%
 next j%
end sub