;*
;*
;* 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