home *** CD-ROM | disk | FTP | other *** search
/ No Fragments Archive 10: Diskmags / nf_archive_10.iso / MAGS / ST_USER / 1989 / USER0989.MSA / RAINBOW.BSC < prev    next >
Text File  |  1989-07-02  |  6KB  |  199 lines
  1. \******************************
  2. \*                            *
  3. \*     Rainbow Colour Demo    *
  4. \*              By            *
  5. \*         Gary Radburn       *
  6. \*                            *
  7. \*    Written in Fast Basic   *
  8. \*                            *
  9. \******************************
  10. \
  11. \Do NOT type in line numbers
  12. \
  13. PROCrainbow_assemble
  14. PROCscreen_setup
  15.  
  16. \Start up the interrupts
  17. CALL start
  18.  
  19. \Wait for keypress
  20. REPEAT:UNTIL INKEY<>-1
  21.  
  22. \Stop the interrupts
  23. CALL stop
  24.  
  25. END
  26.  
  27.  
  28. \Set up screen graphics
  29.  
  30. DEFPROCscreen_setup
  31. HIDEMOUSE
  32. GRAFRECT 0,0,320,200
  33. CLG 1
  34. FILLCOL 2
  35. CIRCLE 160,100,100
  36. GTXTCOL 0
  37. GRAFMODE 2
  38. GTXT 84,198,"Press a key to exit"
  39. GTXTSIZE 13
  40. GTXT 100,50,"Rainbow Graphics"
  41. GTXT 102,80,"On The Atari ST"
  42. GTXT 97,110,"Using Interrupts"
  43. GTXT 153,140,"By"
  44. GTXT 113,170,"Gary Radburn"
  45. ENDPROC
  46.  
  47.  
  48. \Assemble machine code
  49.  
  50. DEFPROCrainbow_assemble
  51. RESERVE code,2000
  52.  
  53. \colour to rotate
  54. colour_rotate=$FF8242          
  55.  
  56. \horizontal blank interrupt vector
  57. hbvec=$120                    
  58.  
  59. \vertical blank interrupt vector
  60. vbvec=$70                     
  61.  
  62. FOR pass=1 TO 2
  63. [ OPT pass,"L-F+W-M+"
  64.   ORG code
  65.  
  66. start
  67.   MOVE.L #setup,-(SP)          \put addr of routine on stack
  68.   MOVE.W #38,-(SP)             \SUPER mode command
  69.   TRAP #14                     \execute setup
  70.   ADDQ.L #6,SP                 \restore stack pointer
  71.   RTS                          \return control
  72.  
  73. setup
  74.   MOVE.B $FFFA09,save1         \save registers
  75.   MOVE.B $FFFA07,save2         \that are used as masks
  76.   MOVE.B $FFFA13,save3         \for the interrupts
  77.   
  78.   MOVE.L hbvec,hbsave          \save original
  79.   MOVE.L vbvec,vbsave          \interrupt vectors
  80.  
  81.   MOVE.W #$F888,col            \initialise the first colour 
  82.   MOVE.W #0,start_red          \as black
  83.   MOVE.W #0,start_green
  84.   MOVE.W #0,start_blue
  85.   MOVE.W #0,red
  86.   MOVE.W #0,green
  87.   MOVE.W #0,blue
  88.   ANDI.B #$FE,$FFFA07          \shut off hblank
  89.   MOVE.L #hblank,hbvec         \change its vector
  90.   ORI.B #1,$FFFA07             \turn it back on
  91.   ORI.B #1,$FFFA13             \get set to change vbi vector
  92.   MOVE.L #vblank,vbvec         \and do it
  93.   RTS                          \exit
  94.  
  95. stop
  96.   MOVE.L #restore,-(SP)        \put addr of routine on stack
  97.   MOVE.W #38,-(SP)             \SUPER mode command
  98.   TRAP #14                     \execute restore
  99.   ADDQ.L #6,SP                 \restore stack pointer
  100.   RTS                          \exit
  101.  
  102. restore
  103.   MOVE.B save1,$FFFA09         \restore all
  104.   MOVE.B save2,$FFFA07         \previously saved
  105.   MOVE.B save3,$FFFA13         \registers
  106.  
  107.   MOVE.L hbsave,hbvec          \restore previously          
  108.   MOVE.L vbsave,vbvec          \saved vectors
  109.   RTS                          \and exit
  110.  
  111. \horizontal blank routine
  112.  
  113. hblank
  114.   MOVE.W col,colour_rotate     \change to new colour
  115.   ADD #1,blue                  \add 1 to blue
  116.   CMPI.W #8,blue               \check if over 7
  117.   BNE cont                     \no - then valid
  118.   MOVE.W #0,blue               \else reset it
  119.   ADD #1,green                 \add 1 to green
  120.   CMPI.W #8,green              \check if over 7
  121.   BNE cont                     \no - then valid
  122.   MOVE.W #0,green              \else reset it
  123.   ADD #1,red                   \add 1 to red
  124.   CMPI.W #8,red                \check if over 7
  125.   BNE cont                     \no - then valid
  126.   MOVE.W #0,red                \else reset it
  127. cont
  128.   MOVEM.L D0-D0/A0-A0,-(SP)    \save registers
  129.   MOVE.W #$F888,col            \set up base number (black)
  130.   MOVE.W red,D0                \get red value
  131.   ASL #8,D0                    \*256
  132.   ADD D0,col                   \add it to base
  133.   MOVE.W green,D0              \get green value
  134.   ASL #4,D0                    \*16
  135.   ADD D0,col                   \add it to base
  136.   MOVE.W blue,D0               \get blue value
  137.   ADD D0,col                   \add it to base
  138.   MOVEM.L (SP)+,D0-D0/A0-A0    \restore registers
  139.   BCLR #0,$FFFA0F              \clear interrupt done flag
  140.   RTE                          \return from exception
  141.  
  142. \vertical blank interrupt routine
  143.  
  144. vblank
  145.   MOVE.B #0,$FFFA1B            \get set to change HBLANK value
  146. verify
  147.   MOVE.B #4,$FFFA21            \set HBLANK to execute for
  148.   CMPI.B #4,$FFFA21            \every 4 scan lines
  149.   BNE verify                   \wait for it to be set
  150.   MOVE.B #8,$FFFA1B            \have changed value
  151.   ADD #1,start_blue            \add one start blue value
  152.   CMPI.W #8,start_blue         \check if over 7
  153.   BNE continue                 \no - then valid
  154.   MOVE.W #0,start_blue         \else reset
  155.   ADD #1,start_green           \add 1 to start green value
  156.   CMPI.W #8,start_green        \check if over 7
  157.   BNE continue                 \no - then valid
  158.   MOVE.W #0,start_green        \else reset
  159.   ADD #1,start_red             \add 1 to start red value
  160.   CMPI.W #8,start_red          \check if over 7
  161.   BNE continue                 \no - then valid
  162.   MOVE.W #0,start_red          \else reset
  163. continue
  164.   MOVEM.L D0-D0/A0-A0,-(SP)    \store registers
  165.   MOVE.W #$F888,col            \set up base value (black)
  166.   MOVE.W start_red,D0          \get start red value
  167.   ASL #8,D0                    \*256
  168.   ADD D0,col                   \add to base value
  169.   MOVE.W start_green,D0        \get start green value
  170.   ASL #4,D0                    \*16
  171.   ADD D0,col                   \add to base value
  172.   MOVE.W start_blue,D0         \get start blue value
  173.   ADD D0,col                   \add to base value
  174.   
  175.   MOVE.W start_blue,blue       \set temp colours as start colours
  176.   MOVE.W start_green,green
  177.   MOVE.W start_red,red
  178.   
  179.   MOVEM.L (SP)+,D0-D0/A0-A0    \restore registers
  180.   DC.W $4EF9
  181. vbsave DS.L 1                  \continue with old vbi
  182.  
  183. save1 DS.W 1                   \save locations for
  184. save2 DS.W 1                   \altered
  185. save3 DS.W 1                   \registers
  186.  
  187. hbsave DS.L 1                  \save location for old hbi interrupt
  188.  
  189. blue DS.W 1                    \temp value for blue
  190. green DS.W 1                   \temp value for green
  191. red DS.W 1                     \temp value for red
  192. start_blue DS.W 1              \initial value of blue
  193. start_green DS.W 1             \initial value of green
  194. start_red DS.W 1               \initial value of red
  195. col DS.W 1                     \calculated colour to portray
  196. ]
  197. NEXT
  198. ENDPROC 
  199.