'
' sample program for STE Hardware Scrolling from GFABASIC
' by ggn/KUA Software
'
b$=SPACE$(32128)
s%=V:b$
FILESELECT "\*.pi1","",f$
BLOAD f$,s%
~XBIOS(6,L:s%+2)
ADD s%,34
xbi=XBIOS(2)
'
vbasehi=&HFF8201
vbasemd=&HFF8203
vbaselo=&HFF820D
linewid=&HFF820F
hscroll=&HFF8265
'
RESERVE -128000
adr=MALLOC(128000)
FOR i=0 TO 199
  BMOVE s%+i*160,adr+i*320,160
  BMOVE s%+i*160,adr+i*320+160,160
NEXT i
FOR i=0 TO 199
  BMOVE adr+(i*2)*160,64000+adr+i*320,160
  BMOVE adr+(i*2)*160,64000+adr+i*320+160,160
NEXT i
'
add=1
REPEAT
  ADD a,add
  IF a\360=a/360
    ADD add,e
    IF add=3
      e=-0.5
    ELSE IF add=1
      e=0.5
    ENDIF
  ENDIF
  VSYNC
  SPOKE hscroll,v
  IF v=0
    SPOKE linewid,80
  ELSE
    SPOKE linewid,76
  ENDIF
  x=320+INT(SINQ(a)*320)
  y=(200+INT(COSQ(a)*200))*320
  IF x<0
    ADD x,319
  ELSE IF x>319
    SUB x,319
  ENDIF
  IF y>63360
    SUB y,64000
  ELSE IF y<640
    ADD y,64000
  ENDIF
  v=x MOD 16
  set_reg(adr+x/2-v/2+y)
  asc=ASC(INKEY$)
UNTIL asc>=49 AND asc<=53
'
REPEAT
  IF y>0
    SUB y,640
  ENDIF
  IF x>0
    DEC x
  ENDIF
  scroll
UNTIL x=0 AND y<=0
'
set_reg(xbi)
SPOKE linewid,0
SPOKE hscroll,0
VSYNC
~MFREE(adr)
RESERVE
BMOVE s%,xbi,32000
SUB asc,49
IF asc=3
  GOTO end
ENDIF
FOR i=0 TO asc
  READ f$
NEXT i
RESERVE 10
~EXEC(0,a$,"","")
RESERVE
end:
END
'
DATA a:\auto\auto\klatrix.prg
DATA a:\auto\auto\fuse.prg
DATA a:\plotting.prg,
DATA a:\chain.prg
'
PROCEDURE scroll
  VSYNC
  SPOKE hscroll,v
  IF v=0
    SPOKE linewid,80
  ELSE
    SPOKE linewid,76
  ENDIF
  v=x MOD 16
  set_reg(adr+x/2-v/2+y)
RETURN
'
PROCEDURE set_reg(value)
  SPOKE vbasehi,SHR(value,16)
  SPOKE vbasemd,SHR(value,8)
  SPOKE vbaselo,value
RETURN