\******************************
\*                            *
\*     Rainbow Colour Demo    *
\*              By            *
\*         Gary Radburn       *
\*                            *
\*    Written in Fast Basic   *
\*                            *
\******************************
\
\Do NOT type in line numbers
\
PROCrainbow_assemble
PROCscreen_setup

\Start up the interrupts
CALL start

\Wait for keypress
REPEAT:UNTIL INKEY<>-1

\Stop the interrupts
CALL stop

END


\Set up screen graphics

DEFPROCscreen_setup
HIDEMOUSE
GRAFRECT 0,0,320,200
CLG 1
FILLCOL 2
CIRCLE 160,100,100
GTXTCOL 0
GRAFMODE 2
GTXT 84,198,"Press a key to exit"
GTXTSIZE 13
GTXT 100,50,"Rainbow Graphics"
GTXT 102,80,"On The Atari ST"
GTXT 97,110,"Using Interrupts"
GTXT 153,140,"By"
GTXT 113,170,"Gary Radburn"
ENDPROC


\Assemble machine code

DEFPROCrainbow_assemble
RESERVE code,2000

\colour to rotate
colour_rotate=$FF8242          

\horizontal blank interrupt vector
hbvec=$120                    

\vertical blank interrupt vector
vbvec=$70                     

FOR pass=1 TO 2
[ OPT pass,"L-F+W-M+"
  ORG code

start
  MOVE.L #setup,-(SP)          \put addr of routine on stack
  MOVE.W #38,-(SP)             \SUPER mode command
  TRAP #14                     \execute setup
  ADDQ.L #6,SP                 \restore stack pointer
  RTS                          \return control

setup
  MOVE.B $FFFA09,save1         \save registers
  MOVE.B $FFFA07,save2         \that are used as masks
  MOVE.B $FFFA13,save3         \for the interrupts
  
  MOVE.L hbvec,hbsave          \save original
  MOVE.L vbvec,vbsave          \interrupt vectors

  MOVE.W #$F888,col            \initialise the first colour 
  MOVE.W #0,start_red          \as black
  MOVE.W #0,start_green
  MOVE.W #0,start_blue
  MOVE.W #0,red
  MOVE.W #0,green
  MOVE.W #0,blue
  ANDI.B #$FE,$FFFA07          \shut off hblank
  MOVE.L #hblank,hbvec         \change its vector
  ORI.B #1,$FFFA07             \turn it back on
  ORI.B #1,$FFFA13             \get set to change vbi vector
  MOVE.L #vblank,vbvec         \and do it
  RTS                          \exit

stop
  MOVE.L #restore,-(SP)        \put addr of routine on stack
  MOVE.W #38,-(SP)             \SUPER mode command
  TRAP #14                     \execute restore
  ADDQ.L #6,SP                 \restore stack pointer
  RTS                          \exit

restore
  MOVE.B save1,$FFFA09         \restore all
  MOVE.B save2,$FFFA07         \previously saved
  MOVE.B save3,$FFFA13         \registers

  MOVE.L hbsave,hbvec          \restore previously          
  MOVE.L vbsave,vbvec          \saved vectors
  RTS                          \and exit

\horizontal blank routine

hblank
  MOVE.W col,colour_rotate     \change to new colour
  ADD #1,blue                  \add 1 to blue
  CMPI.W #8,blue               \check if over 7
  BNE cont                     \no - then valid
  MOVE.W #0,blue               \else reset it
  ADD #1,green                 \add 1 to green
  CMPI.W #8,green              \check if over 7
  BNE cont                     \no - then valid
  MOVE.W #0,green              \else reset it
  ADD #1,red                   \add 1 to red
  CMPI.W #8,red                \check if over 7
  BNE cont                     \no - then valid
  MOVE.W #0,red                \else reset it
cont
  MOVEM.L D0-D0/A0-A0,-(SP)    \save registers
  MOVE.W #$F888,col            \set up base number (black)
  MOVE.W red,D0                \get red value
  ASL #8,D0                    \*256
  ADD D0,col                   \add it to base
  MOVE.W green,D0              \get green value
  ASL #4,D0                    \*16
  ADD D0,col                   \add it to base
  MOVE.W blue,D0               \get blue value
  ADD D0,col                   \add it to base
  MOVEM.L (SP)+,D0-D0/A0-A0    \restore registers
  BCLR #0,$FFFA0F              \clear interrupt done flag
  RTE                          \return from exception

\vertical blank interrupt routine

vblank
  MOVE.B #0,$FFFA1B            \get set to change HBLANK value
verify
  MOVE.B #4,$FFFA21            \set HBLANK to execute for
  CMPI.B #4,$FFFA21            \every 4 scan lines
  BNE verify                   \wait for it to be set
  MOVE.B #8,$FFFA1B            \have changed value
  ADD #1,start_blue            \add one start blue value
  CMPI.W #8,start_blue         \check if over 7
  BNE continue                 \no - then valid
  MOVE.W #0,start_blue         \else reset
  ADD #1,start_green           \add 1 to start green value
  CMPI.W #8,start_green        \check if over 7
  BNE continue                 \no - then valid
  MOVE.W #0,start_green        \else reset
  ADD #1,start_red             \add 1 to start red value
  CMPI.W #8,start_red          \check if over 7
  BNE continue                 \no - then valid
  MOVE.W #0,start_red          \else reset
continue
  MOVEM.L D0-D0/A0-A0,-(SP)    \store registers
  MOVE.W #$F888,col            \set up base value (black)
  MOVE.W start_red,D0          \get start red value
  ASL #8,D0                    \*256
  ADD D0,col                   \add to base value
  MOVE.W start_green,D0        \get start green value
  ASL #4,D0                    \*16
  ADD D0,col                   \add to base value
  MOVE.W start_blue,D0         \get start blue value
  ADD D0,col                   \add to base value
  
  MOVE.W start_blue,blue       \set temp colours as start colours
  MOVE.W start_green,green
  MOVE.W start_red,red
  
  MOVEM.L (SP)+,D0-D0/A0-A0    \restore registers
  DC.W $4EF9
vbsave DS.L 1                  \continue with old vbi

save1 DS.W 1                   \save locations for
save2 DS.W 1                   \altered
save3 DS.W 1                   \registers

hbsave DS.L 1                  \save location for old hbi interrupt

blue DS.W 1                    \temp value for blue
green DS.W 1                   \temp value for green
red DS.W 1                     \temp value for red
start_blue DS.W 1              \initial value of blue
start_green DS.W 1             \initial value of green
start_red DS.W 1               \initial value of red
col DS.W 1                     \calculated colour to portray
]
NEXT
ENDPROC