      PROGRAM TSPOP
C         tests the SpriteOp library
C
C         The SpriteOp library routines are all used as LOGICAL FUNCTIONS.
C         They could also be used as SUBROUTINES when you are sure there
C         will be no errors. This would simplify and speed up the program.
C
C      needs 'utils', 'graphics' and 'spriteop' libraries
C                                       COMMON BLOCK
      COMMON MODE,KOLORS,MROW,MCOL,NXOS,NYOS,NXPIX,NYPIX,IYB,IYT,
     +       IXSCAL,IYSCAL,KBKG
C                 variables are:
C         MODE  = screen mode         KOLORS = number of colours
C         MROW  = bottom text row     MCOL   = right text column
C         NXOS,NYOS  = screen size in OS units
C         NXPIX,NYIX = screen size in pixels
C         IYB,IYT    = bottom and top of graphics window
C         IXSCAL,IYSCAL = scaling from pixels to OS units
C
C                  set up common
      CALL INIT
C                  set up screen and text window
      CALL LAYOUT
C                  test system sprites
      CALL TSYSTS
C                  test user sprites
      CALL TUSERS
C                  test pointer shape
      CALL TPOINT
C                  test oddments
      CALL TODDS
C                  test file handling
      CALL TFILES
      PRINT *,'all done....'
      END
C***
      SUBROUTINE ERROR(RFLAG)
C             to print out SpriteOp errors in cyan
C       RFLAG is true if return expected after error
      COMMON MODE,KOLORS,MROW,MCOL,NXOS,NYOS,NXPIX,NYPIX,IYB,IYT,
     +       IXSCAL,IYSCAL,KBKG
      LOGICAL RFLAG,SP2SCR
      CHARACTER*96 TEXT
      CALL BEEP
      CALL SPERR(IERRNO,TEXT)
      IF(.NOT.SP2SCR()) STOP 'SP2SCR fails'
        CALL GRSETT(0,187,255)
      L = LNBLNK(TEXT)
      PRINT 101,IERRNO,TEXT(1:L)
  101 FORMAT(' error',I6,' in spriteop library'/A)
C          return if requested
        CALL GRSETT(255,255,255)
      IF(RFLAG) RETURN
      STOP
      END
C***
      SUBROUTINE INIT
C        find graphics environment, and store in COMMON
      COMMON MODE,KOLORS,MROW,MCOL,NXOS,NYOS,NXPIX,NYPIX,IYB,IYT,
     +       IXSCAL,IYSCAL,KBKG
      DIMENSION IVAR(12)
C        get the mode
      CALL OSBYTE2(135,0,0,IDUM,MODE)
C        for testing spriteops, restrict modes to 12, 20 or 27 (16-colours)
*      IF(MODE.NE.12 .AND. MODE.NE.20 .AND. MODE.NE.27) THEN
*         PRINT *,'Please switch to modes 12, 20 or 27'
*         PRINT *,'  and re-run'
*         STOP
*      ENDIF
C        get all mode variables
      DO 10 I=1,12
   10 CALL GRRMV(-1,I,IVAR(I))
C
C      PRINT 101,MODE,(I,IVAR(I),I=1,12)
C  101 FORMAT(Z10.8/(I3,I12))
C      STOP
C which gives on pixy:
C  302063D0
C  1         239
C  2         149
C  3    16777215
C  4           1
C  5           1
C  6        7680
C  7     9216000
C  8           0
C  9           5
C 10           5
C 11        1919
C 12        1199
C        # colours
      KOLORS = IVAR(3) + 1
C        check for at least 16 colours
      IF(KOLORS .LT. 16) THEN
         PRINT *,'Please change to a mode with at least 16 colours'
         PRINT *,'This one has only',KOLORS
         PRINT *,'Then run the program again'
         STOP 'Too few colours'
       ENDIF
C        text rows and columns
      MROW = IVAR(2)
      MCOL = IVAR(1)
C        screen size in pixels
      NXPIX = IVAR(11) + 1
      NYPIX = IVAR(12) + 1
C        scaling: pixels to OS units
      IXSCAL = ISHFT(1,IVAR(4))
      IYSCAL = ISHFT(1,IVAR(5))
C        screen size in OS units
      NXOS = NXPIX * IXSCAL
      NYOS = NYPIX * IYSCAL
C
      RETURN
C***
      END
      SUBROUTINE KWAIT
C         wait for keypress
C      PRINT *,'Space to continue, Escape to stop'
       CALL GRWOT(0,5,'Space to continue, Escape to stop')
C         stop if 'escape'
   10 I=IGET()
      IF(I.EQ.27) STOP 'Escape'
      IF(I.NE.32) GO TO 10
C         clear message window
      CALL GRCLRT
      RETURN
      END
C
      SUBROUTINE LAYOUT
C          set up screen and windows
      COMMON MODE,KOLORS,MROW,MCOL,NXOS,NYOS,NXPIX,NYPIX,IYB,IYT,
     +       IXSCAL,IYSCAL,KBKG
      CHARACTER HEADER*21, COL*3
      LOGICAL SPCHAR
C
C          set mode to initialse screen
C      CALL GRSETM(MODE)
C          remove windows
      CALL GRVDU(26)
C         clear screen to black 
        CALL GRSETT(256,0,0)
      CALL GRCLRT
C          set text window in centre of bottom
      IXL = (MCOL + 1)/2 - 20
      CALL GRTWIN(IXL, MROW, IXL+39, MROW-5)
c      CALL GRTWIN(IXL, MROW, IXL+39, MROW-10)
C          set text foreground to white
C          and set text background colour blue
        CALL GRSETT(255,255,255)
        CALL GRSETT(256,68,153)
C          clear text window to background colour
      CALL GRCLRT
C          explain
      PRINT *,'This is a text window'
      PRINT *,'It will contain instructions'
C          translate screen mode to ASCII
      IF(KOLORS.LE.256) THEN
         WRITE (COL,101) KOLORS
  101    FORMAT(I3)
      ELSE
        IF(KOLORS.LE.65536) THEN
          COL='32K'
        ELSE
          COL='16M'
        ENDIF
      ENDIF
      HEADER = COL//' Colour SpriteOps'
C          calculate where to put 21 character double size heading
      IXL = (NXOS * (MCOL - 21 * 1.5))/(2 * MCOL)
      IYT = NYOS - (NYOS * 2) / (MROW + 1)
C          set graphics colour to white
        CALL GRSETC(0,255,255,255)
C          write heading (21 characters long)
      DO 20 I=1,21
        IF(.NOT. SPCHAR(ICHAR(HEADER(I:I)),IXL,IYT,(1.5,2.0))) 
     +       CALL ERROR(.FALSE.)
C            should not cause error, so don't expect return from ERROR
        IXL = IXL + (1.5*NXOS)/MCOL
   20 CONTINUE
C          now make graphics window in between
      IYB = (NYOS * 6) / (MROW + 1)
      CALL GRGWIN(0, IYB, NXOS-1, IYT)
C          set graphics background to dark grey
      KBKG = 4
        CALL GRSETC(128,119,119,119)
C          clear graphics screen
      CALL GRCLRG
C                  wait for user to press key
      CALL KWAIT
      RETURN
      END
C***
      SUBROUTINE TFILES
C               test sprite area and screen file handling
C                                       COMMON BLOCK
      COMMON MODE,KOLORS,MROW,MCOL,NXOS,NYOS,NXPIX,NYPIX,IYB,IYT,
     +       IXSCAL,IYSCAL,KBKG
C               memory for sprite area in common
      PARAMETER(NSTOR=8000)
      COMMON/AREA/ISTOR(NSTOR),NX,NY
C
      LOGICAL SPADDR,SPAMRG,SPALOD,SPASAV,SPDEFR,SPFLPY,SPINIT,
     +        SPPLXY,SPRENA,SPSLOD,SPSSAV
C           file name
      CHARACTER*20 FILNAM
      DATA FILNAM/'<Wimp$Scrap>'/
C           first initialise the sprite area
      IF(.NOT.SPINIT(NSTOR,ISTOR)) CALL ERROR(.FALSE.)
C           make a simple sprite
        CALL GRSETC(0,224,0,0)
      CALL GRORIG(0,IYB)
      CALL GRCIRC(200,200,60,.TRUE.)
        CALL GRSETC(3,0,68,153)
      CALL GRRECT(100,100,200,200,.FALSE.)
      IF(.NOT.SPDEFR(ISTOR,'sprt',KOLORS.LE.256,100,100,200,200))
     +      CALL ERROR(.FALSE.)
      PRINT *,'define sprite'
      CALL KWAIT
C          now save the sprite area
      IF(.NOT.SPASAV(ISTOR,FILNAM)) CALL ERROR(.FALSE.)
      PRINT *,'sprite saved to ',FILNAM
      CALL KWAIT
C          reflect and rename the sprite
      IF(.NOT.SPFLPY(ISTOR,'sprt')) CALL ERROR(.FALSE.)
      IF(.NOT.SPRENA(ISTOR,'sprt','oldspr')) CALL ERROR(.FALSE.)
C          merge back the original
      IF(.NOT.SPAMRG(ISTOR,FILNAM)) CALL ERROR(.FALSE.)
C          plot them both
      CALL GRCLRG
      IF(.NOT.SPPLXY(ISTOR,'sprt',0,0,0)) CALL ERROR(.FALSE.)
      IF(.NOT.SPPLXY(ISTOR,'oldspr',104,0,0)) CALL ERROR(.FALSE.)
      PRINT *,'merge it back and plot it'
      PRINT *,'next to the original inverted'
      CALL KWAIT
C             now read back the sprite
      PRINT *,'read it back and plot it'
      PRINT *,'next to the original inverted'
      IF(.NOT.SPALOD(ISTOR,FILNAM)) CALL ERROR(.FALSE.)
C          plot them both
      CALL GRCLRG
      IF(.NOT.SPPLXY(ISTOR,'sprt',0,0,0)) CALL ERROR(.FALSE.)
C          oldspr does not exist, so this will cause an error
      IF(.NOT.SPPLXY(ISTOR,'oldspr',104,0,0)) CALL ERROR(.TRUE.)
      PRINT *,'the inverted original has gone!'
      CALL KWAIT
C          now plot 100 of them at random, but first get the address of the 
C          sprite 'sprt'
      IF(.NOT.SPADDR(ISTOR,'sprt',IADDR)) CALL ERROR(.FALSE.)
      DO 10 I = 1, 100
        IX = NXOS * RND01()
        IY = (IYT -IYB) * RND01()
        IF(.NOT.SPPLXY(ISTOR,IADDR,IX,IY,0)) CALL ERROR(.FALSE.)
   10 CONTINUE
      PRINT *,'a random pattern'
*      PRINT *,'next, save the screen'
      CALL KWAIT
****      screensave/load do not work on RISCOS 3.5 onwards
*      IF(.NOT.SPSSAV(FILNAM,KOLORS.LE.16)) CALL ERROR(.FALSE.)
*      CALL GRCLRG
*      PRINT *,'screen has been saved to file'
*      PRINT *,'and cleared. Now read it back'
*      CALL KWAIT
*      IF(.NOT.SPSLOD(FILNAM)) CALL ERROR(.FALSE.)
*      CALL OSCLI('DELETE <Wimp$Scrap>')
      RETURN
      END
C***
      SUBROUTINE TLINES
C               test removing and creating
C               rows and columns in a sprite
C                                       COMMON BLOCK
      COMMON MODE,KOLORS,MROW,MCOL,NXOS,NYOS,NXPIX,NYPIX,IYB,IYT,
     +       IXSCAL,IYSCAL,KBKG
C               memory for sprite area in common
      PARAMETER(NSTOR=8000)
      COMMON/AREA/ISTOR(NSTOR),NX,NY
      LOGICAL MASK
      LOGICAL SPDELC,SPDELM,SPDELR,SPDELS,SPINSC,SPINSR,SPPLXY,SPPM,
     +        SPPMSC,SPPMXY,SPRMSK,SPWPIX
C         we have a simple square sprite ('tile') of dimension NXxNY
C         Plot it again, and its mask
      IF(.NOT.SPPLXY(ISTOR,'tile',12,0,8)) CALL ERROR(.FALSE.)
        CALL GRSETC(0,187,187,187)
      CALL GRRECT(0,168,NXOS-1,IYT-IYB-1,.TRUE.)
      CALL GRMOVE(12,180)
      IF(.NOT.SPPM(ISTOR,'tile')) CALL ERROR(.FALSE.)
      PRINT *,'here is the original tile'
      PRINT *,'and its mask,'
      PRINT *,'the tile has size',NX,' by',NY
      CALL KWAIT
C
C         let us add 4 rows in the middle,
      DO 10 IY = 1, 4
        IF(.NOT.SPINSR(ISTOR,'tile',NY/2)) CALL ERROR(.FALSE.)
   10 CONTINUE
C         it now has NY+4 rows (0 through NY+3)
      IF(.NOT.SPPLXY(ISTOR,'tile',156,0,8)) CALL ERROR(.FALSE.)
      PRINT *,'and the same with rows'
      PRINT *,'added in the middle'
      CALL KWAIT
C         remove 2 columns from the left
      DO 20 IY = 1, 2
        IF(.NOT.SPDELC(ISTOR,'tile',0)) CALL ERROR(.FALSE.)
   20 CONTINUE
C         and remove 2 from the right
      DO 30 IY = 1, 2
        IF(.NOT.SPDELC(ISTOR,'tile',NX-4)) CALL ERROR(.FALSE.)
   30 CONTINUE
C         plot it
      IF(.NOT.SPPLXY(ISTOR,'tile',300,0,8)) CALL ERROR(.FALSE.)
      PRINT *,'and the same with columns'
      PRINT *,'removed from the edges'
      CALL KWAIT
C          fix up NX and NY
      NX = NX - 4
      NY = NY + 4
C          now do the converse; add 4 columns in the middle
      DO 40 IX = 1, 4
        IF(.NOT.SPINSC(ISTOR,'tile',NX/2)) CALL ERROR(.FALSE.)
   40 CONTINUE
C          and delete two rows from the top and bottom
      DO 50 IY = 1, 2
        IF(.NOT.SPDELR(ISTOR,'tile',0)) CALL ERROR(.FALSE.)
        IF(.NOT.SPDELR(ISTOR,'tile',NY-IY-2)) CALL ERROR(.FALSE.)
   50 CONTINUE
C         plot it
      IF(.NOT.SPPLXY(ISTOR,'tile',444,0,8)) CALL ERROR(.FALSE.)
      PRINT *,'the same with columns added'
      PRINT *,'and rows removed'
      CALL KWAIT
C          fix up NX and NY
      NX = NX + 4
      NY = NY - 4
      PRINT *,'colour cyan the parts'
      PRINT *,'where the mask is opaque'
      DO 70 IX = 0, NX-1
        DO 60 IY = 0, NY-1
          IF(.NOT.SPRMSK(ISTOR,'tile',IX,IY,MASK)) CALL ERROR(.FALSE.)
          IF(MASK) THEN
            IF(.NOT.SPWPIX(ISTOR,'tile',IX,IY,15,0)) CALL ERROR(.FALSE.)
          ENDIF
   60   CONTINUE
   70 CONTINUE
      PRINT *,'and plot it again'
      IF(.NOT.SPPLXY(ISTOR,'tile',582,0,8)) CALL ERROR(.FALSE.)
      CALL KWAIT
      PRINT *,'now let''s see the mask'
      IF(.NOT.SPPMXY(ISTOR,'tile',582,180)) CALL ERROR(.FALSE.)
      PRINT *,'and a BIG version of the mask'
      IF(.NOT.SPPMSC(ISTOR,'tile',444,324,(2.0,2.0)))
     +       CALL ERROR(.FALSE.)
      CALL KWAIT
      PRINT *,'delete the mask'
      IF(.NOT.SPDELM(ISTOR,'tile')) CALL ERROR(.FALSE.)
      PRINT *,'and try to plot it again...'
      IF(.NOT.SPPMXY(ISTOR,'tile',726,180)) CALL ERROR(.FALSE.)
      PRINT *,'... it''s as if it were all opaque'
      CALL KWAIT
      CALL GRCLRG
C         finished with this sprite, delete it
      IF(.NOT.SPDELS(ISTOR,'tile')) CALL ERROR(.FALSE.)
      RETURN
      END
C***
      SUBROUTINE TODDS
C               test odd remaining sprite commands
C                                       COMMON BLOCK
      COMMON MODE,KOLORS,MROW,MCOL,NXOS,NYOS,NXPIX,NYPIX,IYB,IYT,
     +       IXSCAL,IYSCAL,KBKG
C               memory for sprite area in common
      PARAMETER(NSTOR=8000)
      COMMON/AREA/ISTOR(NSTOR),NX,NY
C
      LOGICAL SPASIZ,SPCPAL,SPDEFR,SPDELP,SPINIT,SPLEFT,
     +        SPPLAA,SPPLSC,SPPLTR
C                pixel translation table
      CHARACTER*256 PIXTR
C                source area, translation matrix
C                and final parallelogram  for SPPLTR
      DIMENSION ISRCE(4),TRANS(6),PARAL(8)
      DATA ISRCE/0,8,8,1/,TRANS/8.,2.,-2.,8.,512.,0./
      DATA PARAL/512.,640., 768.,512., 768.,384., 512.,512./
C             initialise the sprite area
      IF(.NOT.SPINIT(NSTOR,ISTOR)) CALL ERROR(.FALSE.)
C            make a sprite from the letter G
      CALL GRORIG(0,IYB)
        CALL GRSETC(0,255,255,255)
      CALL GRWOG(8,30,'G')
      IF(.NOT.SPDEFR(ISTOR,'G',.FALSE.,8,0,22,30))
     +    CALL ERROR(.FALSE.)
C            fix up the source size
      PRINT *,'make a sprite from the letter G'
      CALL KWAIT
      ISRCE(1)=0
      ISRCE(2)=32/IYSCAL
      ISRCE(3)=16/IXSCAL
      ISRCE(4)=4/IYSCAL
      PRINT *,'try removing left hand wastage...'
C            find space left
      IF(.NOT.SPASIZ(ISTOR,ISZ,NS,JFREE1)) CALL ERROR(.FALSE.)
      PRINT *,'free space goes from',JFREE1
C            remove wastage
      IF(KOLORS.LE.256) THEN
C         not possible in 32K or 16M colours
        IF(.NOT.SPLEFT(ISTOR,'G')) CALL ERROR(.FALSE.)
      ENDIF
C            find new space left
      IF(.NOT.SPASIZ(ISTOR,ISZ,NS,JFREE2)) CALL ERROR(.FALSE.)
      PRINT *,'to',JFREE2,' we gained some back'
      CALL KWAIT
      IF(KOLORS.LE.256) THEN
C         not possible in 32K or 16M colours
        PRINT *,'now add the palette'
        IF(.NOT.SPCPAL(ISTOR,'G')) CALL ERROR(.FALSE.)
C              check free space again
        IF(.NOT.SPASIZ(ISTOR,ISZ,NS,JFREE3)) CALL ERROR(.FALSE.)
        PRINT *,'palette takes up',JFREE2-JFREE3
        CALL KWAIT
        PRINT *,'and take it off again'
        IF(.NOT.SPDELP(ISTOR,'G')) CALL ERROR(.FALSE.)
C              check free space again
        IF(.NOT.SPASIZ(ISTOR,ISZ,NS,JFREE4)) CALL ERROR(.FALSE.)
        PRINT *,'palette took up',JFREE4-JFREE3
        CALL KWAIT
      ENDIF
      CALL GRCLRG
      PRINT *,' plot the G big '
C           initialise the pixel translation to do nothing
      DO 10 I=1,256
        PIXTR(I:I)=CHAR(I-1)
   10 CONTINUE
      CALL KWAIT
      IF(.NOT.SPPLSC(ISTOR,'G',0,0,0,(8.0,8.0),PIXTR))
     +       CALL ERROR(.FALSE.)
      CALL KWAIT
*      PRINT *,'antialiased and coloured'
*      IF(.NOT.SPPLAA(ISTOR,'G',128,0,(8.0,8.0),PIXTR))
*     +       CALL ERROR(.FALSE.)
      PRINT *,'coloured (antialiased no longer supported)'
C         set white to cyan, background to yellow
      PIXTR(1:1)=CHAR(15)
      PIXTR(KBKG+1:KBKG+1)=CHAR(9)
      IF(.NOT.SPPLSC(ISTOR,'G',256,0,0,(8.0,8.0),PIXTR))
     +       CALL ERROR(.FALSE.)
      CALL KWAIT
      PRINT *,'now a couple of linear transforms'
      PRINT *,'provided you have RISC-OS 3'
C         try a linear transformation
      IF(.NOT.SPPLTR(ISTOR,'G',2,ISRCE,0,TRANS,PIXTR))
     +       CALL ERROR(.FALSE.)
      IF(.NOT.SPPLTR(ISTOR,'G',1,ISRCE,0,PARAL,PIXTR))
     +       CALL ERROR(.FALSE.)
      CALL KWAIT
        CALL GRSETC(128,119,119,119)
      CALL GRCLRG
      RETURN
      END
C***
      SUBROUTINE TPOINT
C               test odd remaining sprite commands
C                                       COMMON BLOCK
      COMMON MODE,KOLORS,MROW,MCOL,NXOS,NYOS,NXPIX,NYPIX,IYB,IYT,
     +       IXSCAL,IYSCAL,KBKG
C               memory for sprite area in common
      PARAMETER(NSTOR=8000)
      COMMON/AREA/ISTOR(NSTOR),NX,NY
C
      LOGICAL SPINIT,SPSETP,SPRESV,SPWPIX
      LOGICAL INBOX,INBX2
C               initialise sprite area
      IF(.NOT.SPINIT(NSTOR,ISTOR)) CALL ERROR(.FALSE.)
C               make up a sprite for the pointer
C               it has to be in a 4-colour mode, try mode 8.
      IF(.NOT.SPRESV(ISTOR,'ptr_mine',0,32,16,8)) CALL ERROR(.FALSE.)
C               now put in the pixels using colours 0,1 to 3

      DO 20 IY = 0, 15
        DO 10 IX = 0, 31
          IF(IY.EQ.0 .OR. IY.EQ.15) THEN
C              grey top and bottom
            IF(.NOT.SPWPIX(ISTOR,'ptr_mine',IX,IY,1,0))
     +          CALL ERROR(.FALSE.)
          ELSE
            IF(IX.LT.2 .OR. IX.GT.29) THEN
C              grey edges
              IF(.NOT.SPWPIX(ISTOR,'ptr_mine',IX,IY,1,0))
     +          CALL ERROR(.FALSE.)
            ELSE
C              white middle
              IF(.NOT.SPWPIX(ISTOR,'ptr_mine',IX,IY,0,0))
     +          CALL ERROR(.FALSE.)
            ENDIF
          ENDIF
C              now the black cross
          IY2 = IY + IY
          IY2M = 30 - IY2
          IF((IX.GE.IY2 .AND. IX.LT.IY2+2) .OR.
     +       (IX.GE.IY2M .AND. IX.LT.IY2M+2)) THEN
            IF(.NOT.SPWPIX(ISTOR,'ptr_mine',IX,IY,3,0))
     +          CALL ERROR(.FALSE.)
          ENDIF
   10   CONTINUE
   20 CONTINUE
      IF(.NOT.SPSETP(ISTOR,'ptr_mine',2+64,16,8,0,0))
     +    CALL ERROR(.FALSE.)
C                define box for test
      IXB1 = NXOS/4
      IXB2 = 3 * IXB1
      IYB1 = (IYT - IYB)/4
      IYB2 = 3 * IYB1
      CALL GRORIG(0,IYB)
        CALL GRSETC(0,0,187,255)
      CALL GRRECT(IXB1,IYB1,IXB2,IYB2,.FALSE.)
      PRINT *,'move the pointer in and out of'
      PRINT *,'the box'
      PRINT *
      PRINT *,'press any mouse button to proceed'
      CALL MOUSE(IX,IY,IB)
      INBOX = IX.GT.IXB1 .AND. IX.LT.IXB2 .AND.
     +        IY.GT.IYB1 .AND. IY.LT.IYB2     
   30 CONTINUE
      CALL MOUSE(IX,IY,IB)
      INBX2 = IX.GT.IXB1 .AND. IX.LT.IXB2 .AND.
     +        IY.GT.IYB1 .AND. IY.LT.IYB2
      IF((INBOX.AND..NOT.INBX2).OR.(INBX2.AND..NOT.INBOX)) THEN
        INBOX=INBX2
        I = 1
        IF(INBOX) I = 2
        IF(.NOT.SPSETP(ISTOR,'ptr_mine',I+48,0,0,0,0)) 
     +          CALL ERROR(.FALSE.)
      ENDIF
      IF(IB.EQ.0) GO TO 30
      CALL OSCLI('POINTER 1')
      CALL GRCLRT
      CALL GRCLRG
      RETURN
      END
C***
      SUBROUTINE TSYSTS
C           test out some functions on the system sprite area
      COMMON MODE,KOLORS,MROW,MCOL,NXOS,NYOS,NXPIX,NYPIX,IYB,IYT,
     +       IXSCAL,IYSCAL,KBKG
      CHARACTER*12 SNAME
      LOGICAL SPASIZ,SPASYS,SPRESV,SPPLXY,SPDELS,SPCMSK,
     +        SP2SPR,SP2MSK,SP2SCR
     +,SPINFO
C          set up increment for area size
      NK = 64
      PRINT *,'Setting up ',NK,'K system sprite area'
      IF(.NOT.SPASYS(NK)) CALL SPERR(IERR,SNAME)
      IF(.NOT.SPASIZ(0, NSPR, ISIZ, JFREE)) CALL SPERR(IERR,SNAME)
      ISS = ISIZ/1024
      JFR = JFREE/1024
      PRINT 101,NSPR,ISS,JFR
  101 FORMAT(1X,I4,' system sprites'/' area size',I4,'K'/
     +      ' free space',I4,'K')
      CALL KWAIT
C         now let's make a sprite from scratch
C         first reserve space for a 100x100 sprite without palette
      IF(.NOT.SPRESV(0,'disc',.FALSE.,100,100,-1))
     +     CALL SPERR(IERR,SNAME)
C         now switch VDU to sprite
      IF(.NOT.SP2SPR(0,'disc')) CALL SPERR(IERR,SNAME)
C         draw orange disc on black background
        CALL GRSETC(0,255,187,0)
        CALL GRSETC(128,0,0,0)
      CALL GRCLRG
      CALL GRCIRC(50*IXSCAL,50*IYSCAL,40*IXSCAL,.TRUE.)
C         return VDU to screen
      IF(.NOT.SP2SCR()) CALL SPERR(IERR,SNAME)
C         draw in top left corner
      IY = IYT - 100 * IYSCAL
      IF(.NOT.SPPLXY(0,'disc',0,IY,0)) CALL SPERR(IERR,SNAME)
      PRINT *,'unmasked orange disc',MNEW,MODESP
      CALL KWAIT
C         now mask it
      IF(.NOT.SPCMSK(0,'disc')) CALL SPERR(IERR,SNAME)
C         VDU to the mask
      IF(.NOT.SP2MSK(0,'disc')) CALL SPERR(IERR,SNAME)
C         make it all transparent
        CALL GRSETC(0,255,255,255)
      CALL GRCLRG
C         make opaque disc
        CALL GRSETC(0,0,187,255)
      CALL GRCIRC(50*IXSCAL,50*IYSCAL,40*IXSCAL,.TRUE.)
C         return VDU to screen
      IF(.NOT.SP2SCR()) CALL SPERR(IERR,SNAME)
C         and plot it
      IF(.NOT.SPPLXY(0,'disc',100*IXSCAL,IY,8)) CALL SPERR(IERR,SNAME)
      PRINT *,'masked orange disc'
C         delete sprite
      IF(.NOT.SPDELS(0,'disc')) CALL SPERR(IERR,SNAME)
C         return system area to original size
      IF(NK.GT.0) THEN
        PRINT *,'Removing ',NK,'K system sprite area'
        IF(.NOT.SPASYS(-NK)) CALL SPERR(IERR,SNAME)
      ENDIF
      CALL KWAIT
      CALL GRCLRG
      RETURN
      END
C
      SUBROUTINE TUSERS
C               test sprite manipulation in a user area
C                                       COMMON BLOCK
      COMMON MODE,KOLORS,MROW,MCOL,NXOS,NYOS,NXPIX,NYPIX,IYB,IYT,
     +       IXSCAL,IYSCAL,KBKG
C               memory for sprite area in common
      PARAMETER(NSTOR=8000)
      COMMON/AREA/ISTOR(NSTOR),NX,NY
C
      LOGICAL SPADD,SPASIZ,SPCMSK,SPCOPY,SPDEFC,SPFLPX,SPFLPY,
     +        SPINFO,SPINIT,SPPL,SPPLXY,SPRENA,SPRPIX,SPWMSK
C               initialise sprite area
      IF(.NOT.SPINIT(NSTOR,ISTOR)) CALL ERROR(.FALSE.)
      IF(.NOT.SPASIZ(ISTOR,ISIZE,NSPR,JFREE)) CALL ERROR(.FALSE.)
      PRINT *,'user area free space ',JFREE
      PRINT *,'create a red triangular sprite'
      CALL GRORIG(0,IYB)
        CALL GRSETC(0,222,0,0)
      CALL GRTRI(0,0,0,64,64,0,.TRUE.)
C                this uses graphics coords in order, 
C                so make sprite from graphics cursors
      IF(.NOT.SPDEFC(ISTOR,'tri1',.FALSE.)) CALL ERROR(.FALSE.)
C                give it a mask
*      IF(.NOT.SPCMSK(ISTOR,'tri1')) CALL ERROR(.FALSE.)
      CALL KWAIT
C               make x-flipped copy
      IF(.NOT.SPCOPY(ISTOR,'tri1','tri2')) CALL ERROR(.FALSE.)
      IF(.NOT.SPFLPX(ISTOR,'tri2')) CALL ERROR(.FALSE.)
C               make y-flipped copy
      IF(.NOT.SPCOPY(ISTOR,'tri1','tri3')) CALL ERROR(.FALSE.)
      IF(.NOT.SPFLPY(ISTOR,'tri3')) CALL ERROR(.FALSE.)
C               make x & y-flipped copy
      IF(.NOT.SPCOPY(ISTOR,'tri2','tri4')) CALL ERROR(.FALSE.)
      IF(.NOT.SPFLPY(ISTOR,'tri4')) CALL ERROR(.FALSE.)
      PRINT *,'made 4 triangles from this'
      PRINT *,'plot them'
C               plot the one to the right (the current graphics cursor)
      IF(.NOT.SPPL(ISTOR,'tri3',0)) CALL ERROR(.FALSE.)
C               the one above
      IF(.NOT.SPPLXY(ISTOR,'tri2',0,64,0)) CALL ERROR(.FALSE.)
C               and the 4th
      IF(.NOT.SPPLXY(ISTOR,'tri4',64,64,0)) CALL ERROR(.FALSE.)
      CALL KWAIT
      PRINT *,'now join them together into 1 sprite'
C              first the two at the bottom horizontally
      IF(.NOT.SPADD(ISTOR,'tri1','tri3',.FALSE.)) CALL ERROR(.FALSE.)
C              now the two at the top horizontally
      IF(.NOT.SPADD(ISTOR,'tri2','tri4',.FALSE.)) CALL ERROR(.FALSE.)
C              now the new bottom to the new top
      IF(.NOT.SPADD(ISTOR,'tri2','tri1',.TRUE.)) CALL ERROR(.FALSE.)
C              rename it 
      IF(.NOT.SPRENA(ISTOR,'tri2','tile')) CALL ERROR(.FALSE.)
C         get its size
C         it is 2 bigger than you might think, because
C         SPDEFC collects the rectangle inclusive of all edges
      IF(.NOT.SPINFO(ISTOR,'tile',NX,NY,I,I,I)) CALL ERROR(.FALSE.)
C              plot the new sprite masked 
      IF(.NOT.SPCMSK(ISTOR,'tile')) CALL ERROR(.FALSE.)
C              the mask is not yet correct
      IF(.NOT.SPPLXY(ISTOR,'tile',128,0,8)) CALL ERROR(.FALSE.)
      PRINT *,'this sprite has an opaque mask'
      CALL KWAIT
C           draw a diagonal of sprites to illustrate
      CALL GRCLRG
      IX = 0
      IY = 0
      DO 10 I = 1, 8
        IF(.NOT.SPPLXY(ISTOR,'tile',IX,IY,8)) CALL ERROR(.FALSE.)
      IX = IX + IXSCAL*NX/2
      IY = IY + IYSCAL*NY/2
   10 CONTINUE
      PRINT *,'the sprites lie on top of one'
      PRINT *,'another, like tiles'
      PRINT *,'now make the mask properly'
      CALL KWAIT
C           loop through the pixels
      PRINT *,'fixing up the mask...'
      DO 30 IX = 0, NX-1
        DO 20 IY = 0, NY-1
C              get the colour of pixel (IT is not used for 16 colours)
          IF(.NOT.SPRPIX(ISTOR,'tile',IX,IY,IC,IT)) CALL ERROR(.FALSE.)
C              check for background
          IF(IC.EQ.KBKG) THEN
C              if so, clear mask
            IF(.NOT.SPWMSK(ISTOR,'tile',IX,IY,.FALSE.))
     +            CALL ERROR(.FALSE.)
          ENDIF
   20   CONTINUE
   30 CONTINUE
      PRINT *,'draw the sprites again'
      CALL GRCLRG
      IX = 0
      IY = 0
      DO 40  I = 1, 8
        IF(.NOT.SPPLXY(ISTOR,'tile',IX,IY,8)) CALL ERROR(.FALSE.)
      IX = IX + IXSCAL*NX/2
      IY = IY + IYSCAL*NY/2
   40 CONTINUE
      PRINT *,'now the central diamond of'
      PRINT *,'each sprite is transparent'
      CALL KWAIT
C             this routine is long enough, 
C             we have made a good masked sprite called 'tile'
C             now try fixing up its rows an columns
      CALL GRCLRG
      CALL TLINES
      RETURN
      END

