🚀 go-pugleaf

>
>(Flame on)
>What is the advantage of Action! over BASIC, Pascal or C?  Does it fit in one
>of these "families" of languages or is it a new one?  Why we have such a
>proliferation of languages anyway?  I'm still trying to learn AB,MBII and 
>BXE/BXL, familiarizing myself with C, let along trying to learn Pascal and
>Action!
>(Flame off)

Action! is a compact, powerful, structured language.  It can easily be
used to write sophisticated code taking advantage of specialized system
hardware.  It compiles quickly, and can be used to generate stand-alone
applications.

Action! is available as a cartridge from O.S.S.  The cartridge takes up
8K of user memory, but contains (I think) 24K worth of code inside.
It consists of three different programs

	(1) a full screen editor.
	(2) a compiler
	(3) a run-time support package

In addition, O.S.S. offers a stand-alone run-time package (both for commercial
and private release), and a toolkit of useful packages.  It is possible to
write very complicated programs in ACTION!.  I have written both an 80
column software card in ACTION! as well as a number of graphics games.

In action it is possible to write dli, vbi, and interrupts attached to
other system timers.  There are a number of bugs in the cartridge, but
they have been quite well documented in Analog magazine.

To give you an idea of the flavour and power of the machine, I have enclosed
a very simple game (the idea of which was stolen from an Analog game
which was published in 6502 code).  You are a rabbit, and your job is to
pick up numbers that appear on the screen.  In addition, you have a gun
which can be used to shoot the numbers (you don't get any points for them),
and to shoot at the walls which will close in on you.  You will need a 
joystick in port #1 to play the game.

About ACTION!.  Spacing is up to you, the compiler doesn't care.
There are a number of tricks in the following code.  The first CARD array is
allocated memory last, so the address of "last" will contain the
first usable memory location.  This game builds its own screen and
allocates space for the display list, players, etc.  Declarations
of the form
CARD x=$FFFF
declare x as a CARD (16 bit unsigned) allocated at memory location $FFFF,
while
CARD x=[$FFFF]
declares x as a CARD with initial value $FFFF. Note that routines can
be coded the same way (see SETVBV for example).
All declarations are static, and subroutines are not recursive.  Code
blocks can be included (SAVETEMPS and GETTEMPS are code blocks) to allow
machine code to be included in-line.  SAVETEMPS and GETTEMPS save the
ACTION! registers for interrupt routines.
;---------- cut here ------------
;*
;*
;* harvey.act - based on an Analog game 
;*              of the same name.
;* (c) 1985 Michael Jenkin
;* 
;* compile with lower case on
;*
CARD ARRAY last(2)
BYTE ARRAY pm,misl,plr0,
   plr1, plr2, plr3,dl,sline,rnum,
   snum,disp,ctbl(3)=[$10 $50 $90],
   vtbl(3),atbl(3),byloc(2),bxloc(2),
   metro(2)=[38 41],winc(4),shotx(4),
   shoty(4),sincx(4),sincy(4),
   gomsg=['g 'a 'm 'e 0 0 'o 'v 'e
   'r],psmsg=['p 'r 'e 's 's 0 0 's 't
   'a 'r 't],RTCLOK(3)=$0012,
   stblx(4)=[$01 $FF 0 0],
   stbly(4)=[0 0 $01 $FF],
   harlf1(12)=[0 0 $12 $0A $3C $74 
     $3C $1C $1E $3E $3F $7E],
   harlf2(12)=[0 0 $0B $0A $3C $74
     $3C $1C $1E $3E $3F $7E],
   harrt1(12)=[0 0 $48 $50 $3C $2E
     $3C $38 $78 $7C $FC $7E],
   harrt2(12)=[0 0 $D0 $50 $3C $2E
     $3C $38 $78 $7C $7C $EF],
   harfr1(12)=[0 0 $42 $24 $3C $14
     $3C $18 $3C $7E $7E $E7],
   harfr2(12)=[0 0 $42 $24 $3C $28
     $3C $18 $3C $7E $7E $E7],
   hardn1(12)=[0 0 $44 $24 $3C $14 
     $3C $18 $3C $7E $FE $07],
   hardn2(12)=[0 0 $22 $24 $3C $28
     $3C $18 $3C $7E $7F $E0],
   harup1(12)=[0 0 $44 $24 $3C $3C
     $3C $18 $3C $66 $FE $07],
   harup2(14)=[0 0 $22 $24 $3C $3C
     $3C $18 $3C $66 $7F $E0 0 0],
   mismsk(4)=[$03 $0C $30 $C0],
   M0PF(4),HPOSM0(4)=$D004

BYTE lives,HPOSP2=$D002,HPOSP3=$D003,
   harx, hary,SDMCTL=$022F,
   GRACTL=$D01D,PMBASE=$D407,
   COLOR2=$02C6,COLOR3=$02C7,
   COLOR4=$02C8,PCOLR0=$02C0,
   PCOLR1=$02C1,PCOLR2=$02C2,
   PCOLR3=$02C3,strigf,tim2st,
   tictoc,AUDF1=$D200,vol1,
   HITCLR=$D01E,diesw,vol2,
   IRQEN=$D20E,GPRIOR=$026F,
   CONSOL=$D01F,VCOUNT=$D40B,
   WSYNC=$D40A,COLBK=$D01A,
   RANDOM=$D20A,AUDC1=$D201,
   AUDC2=$D203,AUDC4=$D207,
   AUDC3=$D205,poplt,popft,
   P0PF=$D004,POPL=$D00C,
   nsound,freq3,AUDF3=$D204,
   AUDF2=$D202,ATRACT=$004D,
   xtemp,ytemp,STICK0=$0278,
   STRIG0=$0284,HPOSP0=$D000
CARD CDTMV1=$0218,CDTMV2=$021A,
   CDTMA1=$0226,CDTMA2=$0228
CARD ARRAY pk1(11),pk2(11)

DEFINE
   SAVETEMPS="[$A2 7 $B5 $A8 $48 $CA $10 $FA]",
   GETTEMPS="[$A2 0 $68 $95 $A8 $E8
                      $E0 8 $D0 $F8]",
   XITVBV="[$4C $E462]"

PROC SETVBV=$E45C(BYTE areg,xreg,yreg)

PROC DLinit()
   CARD sdlist=$0230
   BYTE i
   BYTE POINTER k
   pm = (last + $0FFF) & $F000
   misl = pm + $180
   plr0 = misl + $80
   plr1 = plr0 + $80
   plr2 = plr1 + $80
   plr3 = plr2 + $80
   dl = plr3 + $80
   sline = dl + 24
   rnum = sline + 8
   snum = rnum + 8
   disp = snum + 4
   FOR i = 0 TO 3 DO
      dl(i) = $70
   OD
   dl(4) = $47
   dl(5) = disp & $FF
   dl(6) = disp RSH 8
   FOR i = 7 TO 15 DO
      dl(i) = $07
   OD
   dl(16) = $70
   dl(17) = $70
   dl(18) = $46
   dl(19) = sline & $FF
   dl(20) = sline RSH 8
   dl(21) = $41
   dl(22) = dl & $FF
   dl(23) = dl RSH 8
   SDLIST = dl   
   k = "RABBITS:3 SCORE:0000"
   FOR i = 0 TO 19 DO
      k ==+ 1
      sline(i) = k^ + $A0
   OD
   Zero(disp,200)
RETURN

PROC pkinit()
   pk1(0) = harrt1
   pk1(1) = harrt1
   pk1(2) = harrt1
   pk1(3) = 0
   pk1(4) = harlf1
   pk1(5) = harlf1
   pk1(6) = harlf1
   pk1(7) = 0
   pk1(8) = hardn1
   pk1(9) = harup1
   pk1(10)= harfr1
   pk2(3) = 0
   pk2(0) = harrt2
   pk2(1) = harrt2
   pk2(2) = harrt2
   pk2(3) = 0
   pk2(4) = harlf2
   pk2(5) = harlf2
   pk2(6) = harlf2
   pk2(7) = 0     
   pk2(8) = hardn2
   pk2(9) = harup2
   pk2(10)= harfr2
RETURN

PROC Putnum(BYTE n)
   BYTE x, y, RANDOM=$D20A
   DO
      x = RANDOM
      IF x < 200 AND disp(x) = 0 THEN
         EXIT
      FI
   OD
   DO
      y = RANDOM & $0F
      IF y < 10 THEN 
         EXIT
      FI
   OD
   disp(x) = y % ctbl(n)
   atbl(n) = x
   vtbl(n) = y
RETURN

PROC Eranum(BYTE n)
   BYTE x
   x = atbl(n)
   disp(x) = 0
RETURN 

PROC vbgmovr()
   BYTE n
   BYTE POINTER j
   AUDC1 = 0
   AUDC2 = 0
   AUDC3 = 0
   AUDC4 = 0
   CDTMV1 = 0
   CDTMV2 = 0
   j = gomsg
   FOR n = 0 TO 9 DO
      disp(85+n) = j^
      j ==+ 1
   OD
   j = psmsg
   FOR n = 0 TO 11 DO
      disp(144+n) = j^
      j ==+ 1
   OD
RETURN

PROC vbwalls()
   IF winc(0) <> 0 THEN
      winc(0) ==- 1
      IF byloc(0) > 30 THEN
         byloc(0) ==- 1
      FI
   FI
   IF winc(1) <> 0 THEN
      winc(1) ==- 1
      IF byloc(1)  <= 204 THEN
         byloc(1) ==+ 1
      FI
   FI
   IF winc(2) <> 0 THEN
      winc(2) ==- 1
      HPOSP2 = bxloc(0)
      IF bxloc(0) > 39 THEN
         bxloc(0) ==- 1
      FI
   FI
   IF winc(3) <> 0 THEN
      winc(3) ==- 1
      HPOSP3 = bxloc(1)
      IF bxloc(1) < 208 THEN
         bxloc(1) ==+ 1
      FI
   FI
RETURN

PROC vbplayer()
   BYTE d,x
   CARD pic
   xtemp = 0
   ytemp = 0
   IF STICK0 <> $0F AND
          (RTCLOK(2) & $07) <> 0 THEN
      AUDF2 = $10
      VOL2 = $04
   FI                      
   d = STICK0 - 5
   IF (RTCLOK(2) RSH 3 & 1) = 1 THEN
      pic = pk1(d)
   ELSE
      pic = pk2(d)
   FI 
   d = STICK0
   FOR x = 0 TO 3 DO
      IF (d & 1) = 0 THEN
         xtemp = stblx(3-x)
         ytemp = stbly(3-x)
      FI
      d = d RSH 1
   OD
   IF POPLT = $0C THEN
      rnum(0) ==- 1
      lives ==- 1
      diesw ==+ 1
   FI
   IF (POPLT & $04) <> 0 THEN
      harx ==+ 1
      xtemp = 0
   FI
   IF (POPLT & $08) <> 0 THEN
      harx ==- 1
      xtemp = 0
   FI
   IF (byloc(0) + 2) RSH 1 = hary THEN
      rnum(0) ==- 1
      lives ==- 1
      diesw ==+ 1
   FI
   IF (hary + 10) * 2 = byloc(1) THEN
      rnum(0) ==- 1
      lives ==- 1
      diesw ==+ 1
   FI
   harx ==+ xtemp
   HPOSP0 = harx
   hary ==+ ytemp
   MoveBlock(plr0+hary,pic,14)
RETURN

PROC vbgun()
   BYTE t,x,n,shots=[0]
   t = strigf
   strigf = STRIG0
   IF strigf = 0 AND
          (xtemp % ytemp) <> 0 THEN
      FREQ3 = $40
      AUDC3 = $04
      shots ==+ 1
      x = shots & 3
      sincx(x) = xtemp * 2
      sincy(x) = ytemp * 2
      shotx(x) = harx + 3
      shoty(x) = hary + 8
   FI
   Zero(misl,$80)
   FOR x = 0 TO 3 DO
      IF (sincx(x) % sincy(x)) <> 0 THEN
         shoty(x) ==+ sincy(x)
         IF shoty(x)*2+2 >= byloc(1) THEN
            sincx(x) = 0
            sincy(x) = 0
            winc(1) ==+ 8
         FI
         IF shoty(x)*2-10 <= byloc(0) THEN
            sincx(x) = 0
            sincy(x) = 0
            winc(0) ==+ 8
         FI
         t = shoty(x)
         misl(t) ==% mismsk(x)
         misl(t+1) ==% mismsk(x)
         t = M0PF(x)
         n = 0
         DO
           IF (t&1) = 1 THEN
              eranum(n)
              putnum(n)
              EXIT
           FI
           t = t RSH 1
           N ==+ 1
           IF N = 4 THEN
              EXIT
           FI
         OD
         shotx(x) ==+ sincx(x)
         HPOSM0(x) = shotx(x)
         IF shotx(x) >= bxloc(1) THEN
            sincx(x) = 0
            sincy(x) = 0
            winc(3) ==+ 8
         FI
         IF shotx(x)-6 <= bxloc(0) THEN
            sincx(x) = 0
            sincy(x) = 0
            winc(2) ==+ 8
         FI
      FI
   OD                          
   t = 0
   FOR x = 0 TO 3 DO
      t ==% sincx(x) % sincy(x)
   OD
   IF t = 0 THEN
      AUDC3 = 0
   FI
   FOR t = 0 TO 2 DO
      IF P0PF RSH 1 = 1 THEN
         eranum(t)
         x = vtbl(t)
         putnum(t)
         n = 3
         snum(n) ==+ x
         DO           
            IF snum(n) > '9 +$A0 THEN
               snum(n) = '0 +$A0
               IF n = 0 THEN
                  EXIT
               ELSE
                  n ==- 1
               FI
            ELSE
               EXIT
            FI
         OD
      FI
  OD            
RETURN

PROC vb()
   BYTE n
   SAVETEMPS
   IF diesw <> 0 AND lives = 0 THEN
      vbgmovr()
      GETTEMPS
      XITVBV
   FI 
   poplt = POPL
   popft = P0PF
   IF nsound > 0 THEN
      nsound ==- 1
      AUDC4 =  (nsound RSH 1) % $A0
   FI
   IF vol1 > 0 THEN
      vol1 ==- 1
      AUDC1 = vol1 % $C0
   FI
   IF vol2 > 0 THEN
      vol2 ==- 1
      AUDC2 = vol2 % $80
   FI
   freq3 = freq3 * 4
   AUDF3 = freq3
   IF diesw <> 0 THEN
      diesw ==+ 1
      PCOLR0 ==+ 2
      AUDF2 = PCOLR0 * 8
      AUDC2 = $88
      GETTEMPS
      XITVBV
   FI
   vbwalls()
   ATRACT = 0
   vbplayer()
   vbgun()
   HITCLR = 0
   GETTEMPS
   XITVBV

PROC t1()
   SAVETEMPS
   IF tim2st <> 2 THEN
      tim2st ==- 1
   FI
   CDTMV1 = 256
   rnum(0) = vtbl(0) + $A0
   GETTEMPS
RETURN

PROC t2()
   SAVETEMPS
   CDTMV2 = tim2st
   byloc(0) ==+ 1
   byloc(1) ==- 1
   bxloc(0) ==+ 1
   HPOSP2 = bxloc(0)
   bxloc(1) ==- 1
   HPOSP3 = bxloc(1)
   tictoc ==! 1
   AUDF1 = metro(tictoc)
   vol1 = $08
   GETTEMPS
RETURN
   
PROC init()
   BYTE i, GPRIOR = $026F
   rnum(0) = '3+$A0
   lives = 3
   FOR i = 0 TO 3 DO
      snum(i) = '0+$A0
   OD
   FOR i = 0 TO 2 DO
      putnum(i)
   OD
   Zero(disp,200)
RETURN

PROC play()
   BYTE i
   GPRIOR = $04
   byloc(0) = 40
   byloc(1) = 196
   bxloc(0) = 60
   bxloc(1) = 184
   HPOSP2 = 60
   HPOSP3 = 184
   harx = 122
   hary = 55
   SDMCTL = $2E
   GRACTL = 3
   PMBASE = pm RSH 8
   COLOR2 = $96
   COLOR3 = $48
   PCOLR0 = $18
   PCOLR1 = $98
   PCOLR2 = $34
   PCOLR3 = $C4
   strigf = 1
   SETVBV(7,VB RSH 8, VB & $FF)
   CDTMA1 = t1
   CDTMA2 = t2
   CDTMV1 = 256     
   HITCLR = 0
   diesw = 0
   tictoc = 0
   vol1 = 0
   vol2 = 0
   IRQEN = 0
   FOR i = 0 TO 2 DO
      winc(i) = 0
      shotx(i) = 0
      shoty(i) = 0
      sincx(i) = 0
      sincy(i) = 0
   OD
   Zero(plr0,$80)
   Zero(plr1,$80)
   SetBlock(plr2,$0080,$FF)
   SetBlock(plr3,$0080,$FF)
RETURN

   
PROC MAIN()
   BYTE i=[0],a,b,n
   BYTE ARRAY grp2(4)=$D00F
   pkinit()
   DLINIT()              
   init()
   play()
   DO        
      i = (i + 1) & 1
      a = byloc(i) RSH 1
      b = byloc(i) & 1
      WHILE VCOUNT <> a DO OD
      IF b = 1 THEN
         WSYNC = 1
      FI
      COLBK = RANDOM & $F6
      FOR n = 0 TO 9 DO
         grp2(i) = 0
         WSYNC = 1
         COLBK = RANDOM & $F6
      OD
      COLBK = COLOR4   
      IF (consol & 1) = 0 THEN
         DLINIT()
         init()
         play()
      ELSEIF lives <> 0 AND diesw <> 0 THEN
         play()
      FI
   OD
RETURN   
-- 
--
Michael Jenkin					University of Toronto
USENET:	{decvax,ihnp4,allegra}!utcsri!utai!jenkin
CSNET:	jenkin@Toronto 
BELL: 	416-978-7321