Gem Drop - Source Code

The first half of the game code. (Too large to fit in the Action! editor and compile it all!)

; GEMINC.ACT

; Gem Drop
; by Bill Kendrick
; kendrick@zippy.sonoma.edu
; http://zippy.sonoma.edu/kendrick/

; August 17, 1997 - Sept. 24, 1997

DEFINE NO="0"
DEFINE YES="1"
DEFINE ATARI="0"
DEFINE SEGA="1"
DEFINE BOMB="5"
DEFINE WILDCARD="6"
DEFINE CLOCK="7"
DEFINE SCORE="0"
DEFINE EXPLOSION="1"

Byte Array Blocks(110),MemBuf(4096),
   KillsX(100),KillsY(100),ExY(4)
Card Array ScrVals(15)
Byte KEY=764,CONSOL=53279,
   STICK0=632,STRIG0=644,
   COLPF4=712,PADDL0=624,RTCLOCK=20,
   AUDF0=53760,AUDC0=53761
Byte Level,Controller,Gameover,Frozen,
   Carrying,HowMany,LevelDone,
   FLIP,CHAddr,CIO_status,NumKills,
   WhichPM,ExAnim0,ExAnim1,ExAnim2,
   ExAnim3,TOGL,KillScore,Lines,
   Max_Level,FirstRound,LinesNeeded,
   Happy,ScrH,HiScrH
Card SC=88
Card OLDVEC,CH,PMG,DL,Scr,HiScr

Char Func CIO=*(Byte dev, Card addr, size, Byte cmd, aux1, aux2)
[$29$F$85$A0$86$A1$A$A$A$A$AA$A5$A5
$9D$342$A5$A3$9D$348$A5$A4$9D$349
$A5$A6$F0$8$9D$34A$A5$A7$9D$34B$98
$9D$345$A5$A1$9D$344$20$E456
$8C CIO_status $C0$88$D0$6$98$A4$A0
$99 EOF $A085$60]

Card Func ReadBlock=*(Byte dev, Card addr, size)
[$48$A9$7$85$A5$A9$0$85$A6$A5$A3$5$A4
$D0$6$85$A0$85$A1$68$60$68$20 CIO
$BD$348$85$A0$BD$349$85$A1$60]

Proc Quiet()
Sound(0,0,0,0)
Sound(1,0,0,0)
Sound(2,0,0,0)
Sound(3,0,0,0)
Return

Proc Setup()
Int I
Byte C

CH=(MemBuf/1024)+1
CH=CH*1024
CHAddr=CH/256

Level=1
Controller=0
If PADDL0=1 Then
  Controller=1
Fi
Poke(53775,3)
Poke(53768,0)
Quiet()

Close(1)

Open(1,"D:GEMDROP1.FNT",4,0)
ReadBlock(1,CH,1024)
Close(1)

Open(1,"D:GEMDROP2.FNT",4,0)
ReadBlock(1,CH+1024,1024)
Close(1)

PMG=CH+2048
Zero(PMG,1024)
Poke(53277,3)
Zero(53248,13)
Poke(54279,PMG/256)
PokeC(704,0)
PokeC(706,0)

For I=0 To 3 Do
  ExY(I)=0
Od

TOGL=0

Close(1)
Open(1,"D:GEMDROP.DAT",4,0)
Max_Level=InputBD(1)
HiScr=InputCD(1)
HiScrH=InputBD(1)
Close(1)

ScrVals(0)=0
ScrVals(1)=0
ScrVals(2)=0
ScrVals(3)=1
ScrVals(4)=2
ScrVals(5)=5
ScrVals(6)=10
ScrVals(7)=15
ScrVals(8)=20
ScrVals(9)=25
ScrVals(10)=30
ScrVals(11)=50
ScrVals(12)=100
ScrVals(13)=100
ScrVals(14)=100
Return

Proc VBLANKD()
Byte Pointer Q
Byte I,CHBAS=756,
    PMCOLR0=704,PMCOLR1=705,
    PMCOLR2=706,PMCOLR3=707,
    PMX0=53248,PMX1=53249,
    PMX2=53250,PMX3=53251

FLIP=4-FLIP
CHBAS=CHAddr+FLIP

TOGL=TOGL+1
If TOGL=4 Then
  TOGL=0
  If ExAnim0>0 Then
   PMCOLR0=ExAnim0
   ExAnim0=ExAnim0-1
  Else
   PMX0=0
  Fi

  If ExAnim1>0 Then
   PMCOLR1=ExAnim1
   ExAnim1=ExAnim1-1
  Else
   PMX1=0
  Fi

  If ExAnim2>0 Then
   PMCOLR2=ExAnim2
   ExAnim2=ExAnim2-1
  Else
   PMX2=0
  Fi

  If ExAnim3>0 Then
   PMCOLR3=ExAnim3
   ExAnim3=ExAnim3-1
  Else
   PMX3=0
  Fi
Fi
[$6C OLDVEC]

Proc SETVBV(Byte Which,Card Addr)
Card Pointer Temp
Byte V

Temp=$216+(Which LSH 1)
V=RTCLOCK+1
While V<>RTCLOCK Do oD
Temp^=Addr

FLIP=0
Return

Proc DrawScr(Card Addr, Card Scr, Byte ScrH)
Byte V,I,J
Card Z,SS

SS=ScrH
Z=10

For I=0 To 1 Do
  V=SS/Z
  Poke(Addr+I,96+V)

  For J=1 To V Do
   SS=SS-Z
  Od

  Z=Z/10
Od

SS=Scr
Z=1000

For I=0 To 3 Do
  V=SS/Z
  Poke(Addr+I+2,96+V)

  For J=1 To V Do
   SS=SS-Z
  Od

  Z=Z/10
Od
Return

Proc Draw2Digits(Card Addr, Byte Num)
Byte Z,N
Int I

Z=10
N=Num

For I=0 To 1 Do
  Poke(Addr+I,(N/Z)+96)
  N=N-((N/Z)*Z)
  Z=Z/10
Od
Return

Byte Func RandBlock()
Byte I

If Level<15 Then
  I=Rand(4)+1
Else
  I=Rand(4)+1
  If Rand(20)<10 Then
   I=Rand(4)+8
  Fi
Fi

If Rand(40)<1 Then
  I=4+Rand(4)
Fi
Return(I)

Proc Pause()
Int Z

For Z=0 To 5 Do
Od
Return

Proc DrawGameScreen()
Byte A,CHBAS=756
Card VVBLKD=$224

Graphics(0)
Poke(559,46)
DL=PeekC(560)+4
For A=2 To 24 Do
  Poke(DL+A,4)
Od
Poke(DL-1,68)

CHBAS=CHAddr

Poke(708,74)
Poke(709,206)
Poke(710,138)
Poke(711,30)

OLDVEC=VVBLKD
SETVBV(7,VBLANKD)

MoveBlock(SC+2,"QRSTU"+1,5)
SetBlock(SC+41,7,'♦)

MoveBlock(SC+31,"VWXVQRSTU"+1,9)
SetBlock(SC+72,7,'♦)
DrawScr(SC+72,HiScr,HiScrH)

MoveBlock(SC+122,"YW[UQ"+1,5)

MoveBlock(SC+153,"YUZUY"+1,5)
Return

Proc DrawBlock(Byte X, Y)
Card Loc,V
Byte C

Loc=SC+Y*80+10+(X LSH 1)
C=Blocks(Y*10+X)

If C=0 Then
  PokeC(Loc,0)
  PokeC(Loc+40,0)
Else
  V=(C LSH 2)-2
  V=V+((C LSH 2)-1)*256
  PokeC(Loc,V)

  V=C LSH 2
  V=V+((C LSH 2)+1)*256
  PokeC(Loc+40,V)
Fi
Return

Byte Func Title()
Byte Quit,Ok,CHBAS=756,HIGH,LOW
Card SC=88

Graphics(18)
CHBAS=ChAddr+6
MoveBlock(SC+6,"AB┛♥┫EF╲"+1,8)
MoveBlock(SC+87,"HIJ♥◀▶"+1,6)
MoveBlock(SC+127,"KLM"+1,3)
Poke(SC+132,'O-Controller)
HIGH=Level/10
LOW=Level-HIGH*10
MoveBlock(CH+2032,CH+1408+(HIGH LSH 3),8)
MoveBlock(CH+2040,CH+1408+(LOW LSH 3),8)

Quit=NO
Ok=NO

KEY=255
Do Until CONSOL=7 And STRIG0=1 Od

Do
  If KEY=28 Then
   Ok=YES
   Quit=YES
  Fi
  If CONSOL=5 Then
   Level=Level+1
   If Level>Max_Level Then Level=1 Fi
   HIGH=Level/10
   LOW=Level-HIGH*10
   MoveBlock(CH+2032,CH+1408+(HIGH LSH 3),8)
   MoveBlock(CH+2040,CH+1408+(LOW LSH 3),8)
   RTCLOCK=0
   Do Until CONSOL=7 Or RTCLOCK=20 Od
  ElseIf CONSOL=3 Then
   Controller=1-Controller
   Poke(SC+132,'O-Controller)
   Do Until CONSOL=7 Or RTCLOCK=20 Od
  ElseIf CONSOL=6 Or STRIG0=0 Then
   Ok=YES
  Fi
Until Ok=YES Od

KEY=255
Do Until CONSOL=7 And STRIG0=1 Od
Return(Quit)

Proc InitLevel()
Byte X,Y,YY

For Y=0 To 10 Do
  For X=0 To 9 Do
   Blocks(Y*10+X)=0
  Od
Od

YY=Level
If Level>14 Then
  YY=YY-9
Fi
If YY>9 Then YY=9 Fi
For Y=0 To YY Do
  For X=0 To 9 Do
   Blocks(Y*10+X)=RandBlock()
  Od
Od

For Y=0 To 10 Do
  For X=0 To 9 Do
   DrawBlock(X,Y)
  Od
Od

LevelDone=NO

Carrying=0
HowMany=0
Frozen=0
FirstRound=0
If YY<6 Then
  Happy=YES
Else
  Happy=NO
Fi

WhichPM=0
Zero(53248,4)

Lines=0
LinesNeeded=(Level*3)+2

Draw2Digits(SC+164,Lines)
Draw2Digits(SC+204,LinesNeeded)
Draw2Digits(SC+195,Level)
Return

Proc EraseYou(Byte X)
Zero(SC+888+(X LSH 1),6)
Zero(SC+928+(X LSH 1),6)
Return

Proc DrawYou(Byte X)
Card Loc,V1,V2

Loc=SC+890+(X LSH 1)

If HowMany<3 Then
  If Happy=YES Then
   PokeC(Loc,27498) ; 106,107
   PokeC(Loc+40,28012) ; 108,109
  Else
   PokeC(Loc,30582) ; 118,119
   PokeC(Loc+40,31096) ; 120,121
  Fi
Fi

If Carrying<>0 Then
  V1=(Carrying LSH 2)-2
  V1=V1+((Carrying LSH 2)-1)*256

  V2=Carrying*4
  V2=V2+((Carrying LSH 2)+1)*256

  PokeC(Loc+2,V1)
  PokeC(Loc+42,V2)

  If HowMany>=2 Then
   PokeC(Loc-2,V1)
   PokeC(Loc+38,V2)

   If HowMany>=3 Then
    PokeC(Loc,V1)
    PokeC(Loc+40,V2)
   Fi
  Fi
Fi
Return

Proc AddKill(Byte X,Y)
KillsX(NumKills)=X
KillsY(NumKills)=Y

NumKills=NumKills+1
If NumKills>=100 Then
  NumKills=99
Fi

KillScore=KillScore+1
If KillScore>13 Then
  KillScore=13
Fi
Return

Proc ExplodeBlock(Byte X,Y,Typ)
WhichPM=WhichPM+1
If WhichPM=4 Then WhichPM=0 Fi
Zero(PMG+512+WhichPM*128+ExY(WhichPM),8)
Poke(53248+WhichPM,48+(X+5) LSH 3)
If WhichPM=0 Then
  ExAnim0=15
ElseIf WhichPM=1 Then
  ExAnim1=15
ElseIf WhichPM=2 Then
  ExAnim2=15
ElseIf WhichPM=3 Then
  ExAnim3=15
Fi
ExY(WhichPM)=16+(Y LSH 3)

If Typ<>EXPLOSION Then
  MoveBlock(PMG+512+WhichPM*128+ExY(WhichPM),CH+504+(KillScore LSH 3),8)
Else
  MoveBlock(PMG+512+WhichPM*128+ExY(WhichPM),CH+616,8)
Fi
Return

Byte Func Same(Byte A,B)
Byte Match

Match=NO
If A=B Or (A>4 And A<8) Or B=WILDCARD Then
  Match=YES
Fi
Return(Match)

Proc KillBlock(Byte X,Y)
Byte B,C

C=Blocks(Y*10+X)

If C<>0 Then
  Blocks(Y*10+X)=0
  DrawBlock(X,Y)
  ExplodeBlock(X,Y,SCORE)

  For B=0 To 100 Do
   Sound(0,KillScore*20,B,10)
  Od
  AUDF0=0
  AUDC0=0

  If C=BOMB Then
   If Y>0 Then
    Blocks((Y-1)*10+X)=0
    DrawBlock(X,Y-1)
    ExplodeBlock(X,Y-1,EXPLOSION)
   Fi

   If Y<10 Then
    Blocks((Y+1)*10+X)=0
    DrawBlock(X,Y+1)
    ExplodeBlock(X,Y+1,EXPLOSION)
   Fi

   If X>0 Then
    Blocks(Y*10+X-1)=0
    DrawBlock(X-1,Y)
    ExplodeBlock(X-1,Y,EXPLOSION)
   Fi

   If X<9 Then
    Blocks(Y*10+X+1)=0
    DrawBlock(X+1,Y)
    ExplodeBlock(X+1,Y,EXPLOSION)
   Fi
  ElseIf C=CLOCK Then
   Frozen=255
  Fi

  If Y>0 Then
   If Same(Blocks((Y-1)*10+X),C)=YES Then
    AddKill(X,Y-1)
   Fi
  Fi

  If Y<10 Then
   If Same(Blocks((Y+1)*10+X),C)=YES Then
    AddKill(X,Y+1)
   Fi
  Fi

  If X>0 Then
   If Same(Blocks(Y*10+X-1),C)=YES Then
    AddKill(X-1,Y)
   Fi
  Fi

  If X<9 Then
   If Same(Blocks(Y*10+X+1),C)=YES Then
    AddKill(X+1,Y)
   Fi
  Fi
Fi
Return

Proc Honk()
Byte B

Sound(0,50,12,10)
COLPF4=72
For B=0 To 200 Do
  Pause()
Od
COLPF4=0
AUDF0=0
AUDC0=0
Return

Proc Throw(Byte X)
Int LastY
Byte Y,C,Last,NextLast,B,YTop,YBot,
    KX,KY,Ok,DoIt

If Carrying=0 Then
Else
  Last=0
  NextLast=0
  LastY=-1
  For Y=0 To 10 Do
   C=Blocks(Y*10+X)
   If C<>0 Then
    NextLast=Last
    Last=C
    LastY=Y
   Fi
  Od

  Ok=NO
  If Same(Last,Carrying)=YES Then
   If (Same(NextLast,Carrying)=YES Or HowMany>1) Then
    Ok=YES
   Fi
  Fi

  DoIt=YES

  YBot=LastY+1+HowMany-1
  If YBot>10 Then
   DoIt=NO
   YBot=10
   If Ok=YES Or HowMany>2 Then
    DoIt=YES
   Fi
  Fi

  If DoIt=YES Then
   For B=0 To 200 Do
    Sound(0,200-B,10,10)
    Pause()
   Od
   AUDF0=0
   AUDC0=0

   For Y=LastY+1 To YBot Do
    Blocks(Y*10+X)=Carrying
    DrawBlock(X,Y)
   Od

   Ok=NO

   If Same(Last,Carrying)=YES Then
    If (Same(NextLast,Carrying)=YES Or HowMany>1) Then
     Ok=YES
    Fi
   Fi

   If (HowMany>2) Then
    Ok=YES
   Fi

   If Ok=YES Then
    YTop=0
    For Y=0 To YBot Do
     If Blocks(Y*10+X)<>Carrying Then
      YTop=Y+1
     Fi
    Od

    NumKills=0
    KillScore=0
    AddKill(X,YBot)

    Lines=Lines+1

    Draw2Digits(SC+164,Lines)

    B=0
    Do
     KX=KillsX(B)
     KY=KillsY(B)
     KillBlock(KX,KY)

     B=B+1
    Until B>=NumKills Od

    Scr=Scr+ScrVals(KillScore)
    If Scr>=10000 Then
     Scr=Scr-10000
     ScrH=ScrH+1
    Fi

    DrawScr(SC+41,Scr,ScrH)

    If Scr>=HiScr Or ScrH>HiScrH Then
     HiScr=Scr
     HiScrH=ScrH
     DrawScr(SC+72,Scr,ScrH)
    Fi
   Fi

   Carrying=0
   HowMany=0
  Else
   Honk()
  Fi
Fi

If Lines>=LinesNeeded Then
  LevelDone=YES
Fi
Return

Proc Grab(Byte X)
Byte Y,C,Last,LastY,B,Ok

Last=0
LastY=0

For Y=0 To 10 Do
  C=Blocks(Y*10+X)
  If C<>0 Then
   Last=C
   LastY=Y
  Fi
Od

If Last=0 Or (Last>4 And Last<8) Then
  Honk()
Else
  If Last<>Carrying And Carrying<>0 Then
   Honk()
  Else
   Carrying=Last
   Blocks(LastY*10+X)=0
   DrawBlock(X,LastY)
   HowMany=HowMany+1

   Do
    Ok=0
    LastY=LastY-1
    If LastY>=0 Then
     If Blocks(LastY*10+X)=Last Then
      Blocks(LastY*10+X)=0
      DrawBlock(X,LastY)
      Ok=1
      HowMany=HowMany+1
     Fi
    Fi
   Until Ok=0 Od
  Fi

  For B=0 To 200 Do
   Sound(0,B,10,10)
   Pause()
  Od
  AUDF0=0
  AUDC0=0
Fi
Return

Proc AddMore()
Byte X,Y,Y1

For X=0 To 9 Do
  If Blocks(10*10+X)<>0 Then
   GameOver=YES
  Fi
Od

If Gameover=NO Then
  For Y=0 To 9 Do ; Stupid Action!
   Y1=10-Y

   For X=0 To 9 Do
    Blocks(Y1*10+X)=Blocks((Y1-1)*10+X)
    DrawBlock(X,Y1)
   Od
  Od

  For X=0 To 9 Do
   Blocks(0*10+X)=RandBlock()
   DrawBlock(X,0)
  Od
Fi
Return

GEMDROP.ACT

; GEMDROP.ACT

; Gem Drop
; by Bill Kendrick
; kendrick@zippy.sonoma.edu
; http://zippy.sonoma.edu/kendrick/

; August 17, 1997 - Sept. 24, 1997

INCLUDE "GEMRT.ACT"
INCLUDE "GEMINC.ACT"

Proc CheckHappy()
Byte X,Y

Happy=YES
For Y=8 To 10 Do
  For X=0 To 9 Do
   If Blocks(Y*10+X)<>0 Then
    Happy=NO
   Fi
  Od
Od
Return

Proc LevelEndFX(Byte YourX)
Byte X,Y,B,Togl
Card Loc

Loc=SC+890+(YourX LSH 1)
Togl=0

For Y=0 To 10 Do
  For X=0 To 9 Do
   Blocks(Y*10+X)=0
   DrawBlock(X,Y)
  Od
  For X=0 To 9 Do
   If Rand(10)<2 Then
    ExplodeBlock(X,Y,EXPLOSION)
   Fi
  Od
  For B=0 To 150 Do
   Pause()
   Pause()
   Pause()
   Sound(0,B,0,15-B/10)
  Od

  Togl=1-Togl
  If Togl=0 Then
   PokeC(Loc,28526) ; 110,111
   PokeC(Loc+40,29040) ; 112,113
  Else
   PokeC(Loc,29554) ; 114,115
   PokeC(Loc+40,30068) ; 116,117
  Fi

  Pause()
  Pause()
Od
Return

Proc Level15FX()
Byte X,I,T

Zero(53248,4)
Zero(PMG,1024)
Pause()
MoveBlock(PMG+512+000+16+40,57344+('U-32)*8,8)
MoveBlock(PMG+512+128+16+40,57344+('H-32)*8,8)
MoveBlock(PMG+512+256+16+40,57344+('O-32)*8,8)
MoveBlock(PMG+512+384+16+40,57344+('H-32)*8,8)

T=0
For X=0 To 230 Do
  Poke(53248,250-X)
  Poke(53249,250-X+8)
  Poke(53250,250-X+24)
  Poke(53251,250-X+32)
  For I=0 To 50 Do
   Pause()
  Od
  SetBlock(704,4,15)
  Sound(0,X,4,T)
  If (X MOD 10)=0 Then
   Poke(712,T)
   T=15-T
  Fi
Od
Poke(712,0)
Sound(0,0,0,0)
Zero(PMG,1024)
Return

Proc Play()
Byte X,S,K,OX,A,B,FrozCount,
  HappyTest,Fire,SegaFire,Activity,
  OAct
Int Clicks
Card Q,Loc

DrawGameScreen()
InitLevel()
Clicks=0
X=5
Gameover=NO
OAct=0
FrozCount=0
Scr=0
ScrH=0

DrawYou(X)

Do
  S=STICK0
  Fire=STRIG0
  If PADDL0=228 And Controller=SEGA Then SegaFire=0
  Else SegaFire=1
  Fi

  If (S<>15 Or Fire=0 Or SegaFire=0) Then
   OAct=1
   If OAct=1 And RTCLOCK<8 Then
    S=15
    Fire=1
    SegaFire=1
   Else
    RTCLOCK=0
   Fi
  Else
   OAct=0
   RTCLOCK=10
  Fi

  K=KEY
  KEY=255

  If S=7 Then K=7
  ElseIf S=11 Then K=6
  ElseIf S=14 Or SegaFire=0 Then K=14
  ElseIf S=13 Or Fire=0 Then K=15
  Fi

  OX=X

  If K=28 Or CONSOL<7 Then
   Gameover=YES
  ElseIf K=7 Then
   X=X+1
   If X>9 Then X=0 Fi
  ElseIf K=6 Then
   If X>0 Then
    X=X-1
   Else
    X=9
   Fi
  ElseIf K=14 Then
   Throw(X)
   EraseYou(X)
   DrawYou(X)
  ElseIf K=15 Then
   Grab(X)
   EraseYou(X)
   DrawYou(X)
  ElseIf K=33 Then
   Poke(708,2)
   Poke(709,4)
   Poke(710,6)
   Poke(711,8)
   KEY=255
   Do Until KEY=33 Or KEY=28 Or CONSOL<7 Od
   If KEY<>33 Then
    Gameover=YES
   Fi
   KEY=255
   Poke(708,74)
   Poke(709,206)
   Poke(710,138)
   Poke(711,30)
  Fi

  If OX<>X Then
   EraseYou(OX)
   DrawYou(X)
  Fi

  If Frozen=0 Then
   HappyTest=HappyTest+1
   If HappyTest>=100 Then
    HappyTest=0
    CheckHappy()
    DrawYou(X)
   Fi

   Clicks=Clicks+1

   If Level<15 Then Q=Level*125
   Else Q=(Level-10)*100
   Fi

   If Clicks>4500-Q And FirstRound=1 Then
    Poke(DL-2,96+(16*(Clicks MOD 2)))
    Sound(0,100,0,8*(Clicks MOD 2))
   Fi

   If Clicks>4800-Q Then
    If FirstRound=1 Then
     Sound(0,0,0,0)
     Poke(DL-2,112)
     Clicks=0
     AddMore()
    Else
     FirstRound=1
     Clicks=0
    Fi
   Fi
  Else
   Happy=YES

   FrozCount=FrozCount+1

   If FrozCount=60 Then
    FrozCount=0
    Frozen=Frozen-1
    If (Frozen MOD 10)=0 Then
     For B=0 To 15 Do
      Sound(0,(Frozen MOD 20)*10+50,10,15-B)
     Od
    Fi
   Fi
  Fi

  If LevelDone=YES Then
   LevelEndFX(X)

   Level=Level+1
   If Level>20 Then
    Level=20
   Fi
   If Level>Max_Level Then
    Max_Level=Level
   Fi

   If Level=15 Then
     Level15FX()
   Fi

   InitLevel()
   Clicks=0
  Fi
Until Gameover=YES Od

Zero(53248,13)

Quiet()

Loc=SC+880+10+(X LSH 1)

PokeC(Loc,30582) ; 118,119
PokeC(Loc+40,31096) ; 120,121

For A=0 To 254 Do
  Sound(0,A,10,15)
  SetBlock(SC+(A/12)*40+10,20,'\)
  Pause()
  Pause()
  Pause()
  Pause()
Od

MoveBlock(SC+131,"]]]\]]]\]]]]]\]]]\"+1,18)
MoveBlock(SC+171,"]♥♥♥]♥]♥]♥]♥]♥]♥♥♥"+1,18)
MoveBlock(SC+211,"]♥]\]]]♥]♥]♥]♥]]\\"+1,18)
MoveBlock(SC+251,"]♥]♥]♥]♥]♥\♥]♥]♥♥\"+1,18)
MoveBlock(SC+291,"]]]♥]♥]♥]♥\\]♥]]]\"+1,18)
MoveBlock(SC+331,"\♥♥♥\♥\♥\♥\\\♥\♥♥♥"+1,18)

MoveBlock(SC+413,"]]]\]\]\]]]\]]]\"+1,16)
MoveBlock(SC+453,"]♥]♥]♥]♥]♥♥♥]♥]♥"+1,16)
MoveBlock(SC+493,"]♥]♥]♥]♥]]\\]]\♥"+1,16)
MoveBlock(SC+533,"]♥]♥\]\♥]♥♥\]♥]\"+1,16)
MoveBlock(SC+573,"]]]♥\]♥\]]]\]♥]♥"+1,16)
MoveBlock(SC+613,"\♥♥♥\\♥\\♥♥♥\♥\♥"+1,16)

Quiet()

KEY=255
Do Until CONSOL=7 And STRIG0=1 Od

Do
Until KEY<255 Or CONSOL<7 Or STRIG0=0 Od

KEY=255
Do Until CONSOL=7 And STRIG0=1 Od

SETVBV(7,OLDVEC)

Quiet()
Return

Proc QuitApp()
Graphics(0)
Quiet()
PutE()
PrintE("Thanks for playing ◢GEMDrop◣")
PrintE("Please visit NBS's website!")
PrintE("http://zippy.sonoma.edu/kendrick/nbs/")
Return

Proc Main()
Byte Quit

Setup()
Do
  Quit=Title()
  If Quit=NO Then
   Play()
   Graphics(0)
   Poke(559,0)
   Close(1)
   Open(1,"D:GEMDROP.DAT",8,0)
   PrintBDE(1,Max_Level)
   PrintCDE(1,HiScr)
   PrintBDE(1,HiScrH)
   Close(1)
  Fi
Until Quit=YES Od
QuitApp()
Return

GEMRT.ACT

These are "runtime" libraries; things that must be compiled into the game to allow it to run without an Action! programming cartridge installed. (It consists of just the parts of a runtime needed for Gem Drop to run — it appears to be Jeff Reister's PD Runtime package for the Action! 8 bit language, which can be found in the "Code" section of Eric Parent ("Joyful Coder")'s Action! website.)

; GEMRT.ACT
; ACTION! RUNTIME LIBRARY
; FOR GEMDROP

PROC _CPYPRM=*()
SET $4EE = _CPYPRM
[$85$A0$86$A1$84$A2$18$68$85$84$69$03
$A8$68$85$85$69$00$48$98$48$A0$01$B1
$84$85$82$C8$B1$84$85$83$C8$B1$84$A8
$B9$A0$00$91$82$88$10$F8$60]

PROC _CHGSGN=*()
[$85$C0$86$C1$38$A9$00$E5$C0$48$A9$00
$E5$C1$AA$68$60]

PROC _FIXSGN=*()
[$86$C2$E0$00$10$03$20 _CHGSGN $85$82
$86$83$A5$85$45$C2$85$C2$A6$85$10$09
$A5$84$20 _CHGSGN $85$84$86$85$60]

PROC _FIXRES=*()
[$A5$86$A6$87$A4$C2$10$03$4C _CHGSGN
$60]

PROC _MUL=*()
SET $4E8 = _MUL
[$20 _FIXSGN $A9$00$85$86$85$87$A5$82
$D0$04$A5$83$F0$22$A5$84$D0$04$A5$85
$F0$1A$46$85$66$84$90$0D$18$A5$86$65
$82$85$86$A5$87$65$83$85$87$06$82$26
$83$38$B0$D6$4C _FIXRES]

PROC _DIV=*()
SET $4EA = _DIV
[$20 _FIXSGN $A9$00$85$86$85$87$85$C1
$A9$01$85$C0$A5$82$D0$04$A5$83$F0$5F
$A5$84$D0$04$A5$85$F0$57$A5$82$C5$84
$A5$83$E5$85$90$0F$A5$C1$30$0B$06$84
$26$85$06$C0$26$C1$38$B0$E7$A5$C0$D0
$04$A5$C1$F0$36$A5$82$D0$04$A5$83$F0
$2E$A5$82$C5$84$A5$83$E5$85$90$19$38
$A5$82$E5$84$85$82$A5$83$E5$85$85$83
$A5$86$05$C0$85$86$A5$87$05$C1$85$87
$46$85$66$84$46$C1$66$C0$38$B0$C2$4C
_FIXRES]

PROC _MODOP=*()
SET $4EC = _MODOP
[$20 _DIV $A5$82$A6$83$60]

;PROC _RSHOP=*()
;SET $4E6 = _RSHOP
;[$A4$84$F0$0A$86$86$46$86$6A$88$D0$FA
;$A6$86$60]

PROC _LSHOP=*()
SET $4E4 = _LSHOP
[$A4$84$F0$0A$86$86$0A$26$86$88$D0$FA
$A6$86$60]

PROC _ERROU=*()
[$A9$70$AA$A9$0C$9D$42$03$20$56$E4$8A
$38$E9$10$D0$F1$6C$0A$00]

PROC _ERRVEC=*()
[_ERROU]

PROC _DEVIC=*()
[$00]

MODULE
CARD Error=_ERRVEC
BYTE device=_DEVIC

PROC _GOCIO=*()
[$20$56$E4$10$1A$C0$88$F0$06$68$68$98
$6C _ERRVEC $48$8A$48$4A$4A$4A$4A$AA
$A9$01$9D$C0$05$68$AA$68$60]

PROC _LODCHN=*()
[$C9$08$90$07$68$68$A9$86$6C _ERRVEC
$0A$0A$0A$0A$AA$60]

PROC _STONAM=*()
[$18$69$01$9D$44$03$98$69$00$9D$45$03
$60]

PROC _SHFTR=*()
[$48$8A$A8$68$AA$AD _DEVIC $60]

;PROC _CLREOL=*()
;[$48$A9$00$85$A5$68$60]

PROC _SETEOL=*()
[$48$A9$01$85$A5$68$60]

PROC _PRECON=*()
[$8A$48$98$AA$68$A0$03$84$A3$A0$FD$60]

PROC _DOPRNT=*()
[$86$A3$84$A4$20 _LODCHN $A9$00$9D$49
$03$A8$B1$A3$F0$1A$9D$48$03$18$A5$A3
$69$01$9D$44$03$A5$A4$69$00$9D$45$03
$A9$0B$9D$42$03$20 _GOCIO $A5$A5$F0
$12$A9$00$9D$48$03$9D$49$03$A9$0B$9D
$42$03$A9$9B$20 _GOCIO $60]

PROC StrC=*(CARD c, s)
[$85$D4$86$D5$84$A2$20$AA$D9$20$E6$D8
$A0$00$B1$F3$30$06$C8$91$A2$38$B0$F6
$29$7F$C8$91$A2$98$A0$00$91$A2$60]

;PROC StrB=*(BYTE b CARD s)
;[$84$A3$48$8A$A8$A2$00$68$4C StrC]

;PROC StrI=*(INT i CARD s)
;[$E0$00$30$03$4C StrC   $49$FF$85$A2
;$8A$49$FF$AA$E6$A2$D0$01$E8$A5$A2$20
;StrC $A0$00$18$B1$A2$69$01$91$A2$A8
;$88$B1$A2$C8$91$A2$88$88$D0$F7$C8$A9
;$2D$91$A2$60]

PROC _DOPRNC=*()
[$48$20 _PRECON $20 StrC $68$A2$FD$A0
$03$4C _DOPRNT]

;PROC DOPRNI=*()
;[$48$20 _PRECON $20 StrI $68$A2$FD$A0
;$03$4C _DOPRNT]

;PROC PrintCD=*(BYTE d CARD c)
;[$20 _CLREOL $4C _DOPRNC]

;PROC PrintC=*(CARD c)
;[$20 _SHFTR $4C PrintCD]

PROC PrintCDE=*(BYTE d CARD c)
[$20 _SETEOL $4C _DOPRNC]

;PROC PrintCE=*(CARD c)
;[$20 _SHFTR $4C PrintCDE]

;PROC PrintBD=*(BYTE d, b)
;[$A0$00$4C PrintCD]

;PROC PrintB=*(BYTE b)
;[$20 _SHFTR $4C PrintBD]

PROC PrintBDE=*(BYTE d, b)
[$A0$00$4C PrintCDE]

;PROC PrintBE=*(BYTE b)
;[$20 _SHFTR $4C PrintBDE]

;PROC PrintID=*(BYTE d INT i)
;[$20 _CLREOL $4C _DOPRNI]

;PROC PrintI=*(INT i)
;[$20 _SHFTR $4C PrintID]

;PROC PrintIDE=*(BYTE d INT i)
;[$20 _SETEOL $4C _DOPRNI]

;PROC PrintIE=*(INT i)
;[$20 _SHFTR $4C PrintIDE]

;PROC PrintD=*(BYTE d CARD s)
;[$20 _CLREOL $4C _DOPRNT]

;PROC Print=*(CARD s)
;[$20 _SHFTR $4C PrintD]

PROC PrintDE=*(BYTE d CARD s)
[$20 _SETEOL $4C _DOPRNT]

PROC PrintE=*(CARD s)
[$20 _SHFTR $4C PrintDE]

;PROC _HEXSTR=*()
;[$85$84$86$85$A9$FD$85$A2$A9$03$85$A3
;$A0$00$A9$05$91$A2$C8$A9$24$91$A2$A9
;$00$A2$04$06$84$26$85$2A$CA$D0$F8$69
;$30$C9$3A$90$02$69$06$C8$91$A2$C0$05
;$D0$E5$60]

;PROC PrintF=*(CARD s,a,b,c,d,e,f,g)
;[$85$82$86$83$84$A2$AD _DEVIC $0A$0A
;$0A$0A$85$C1$A0$00$84$87$84$C0$B1$82
;$F0$4C$85$86$E6$C0$F0$46$A4$C0$C4$86
;$F0$02$B0$3E$B1$82$C9$25$D0$3E$E6$C0
;$C8$C4$86$F0$02$B0$35$B1$82$C9$25$F0
;$2F$C9$45$F0$29$A8$A6$87$E0$0E$B0$D4
;$B5$A2$48$B5$A3$E8$E8$86$87$AA$68$C0
;$43$F0$15$C0$49$F0$34$C0$48$F0$3C$C0
;$53$F0$3F$38$B0$1D$60$38$B0$B2$A9$9B
;$A8$A6$C1$A9$00$9D$48$03$9D$49$03$A9
;$0B$9D$42$03$98$20 _GOCIO $38$B0$E4
;$A0$03$84$A3$A0$FD$20 StrC $38$B0$0F
;$A0$03$84$A3$A0$FD$20 StrI $38$B0$03
;$20 _HEXSTR $A9$FD$A2$03$85$84$86$85
;$A6$C1$A9$00$9D$49$03$A8$B1$84$F0$B5
;$9D$48$03$18$A5$84$69$01$9D$44$03$A5
;$85$69$00$9D$45$03$A9$0B$9D$42$03$20
;_GOCIO $38$B0$98]

PROC PutD=*(BYTE d, c)
[$86$A0$20 _LODCHN $A9$00$9D$48$03$9D
$49$03$A9$0B$9D$42$03$A5$A0$20 _GOCIO
$60]

;PROC PutDE=*(BYTE d)
;[$A2$9B$4C PutD]

PROC Put=*(BYTE c)
[$AA$AD _DEVIC $4C PutD]

PROC PutE=*()
[$A9$9B$4C Put]

;BYTE FUNC ValB=*(CARD a)
CARD FUNC ValC=*(CARD a)
;INT FUNC ValI=*(CARD a)
[$85$A2$86$A3$A9$00$85$A0$85$A1$85$A5
$A8$B1$A2$85$A4$C8$B1$A2$C9$20$F0$F9
$C9$2D$D0$0B$C6$A5$C8$C4$A4$F0$02$B0
$31$B1$A2$38$E9$30$90$2A$C9$0A$B0$26
$48$06$A0$26$A1$A5$A0$A6$A1$0A$26$A1
$0A$26$A1$18$65$A0$85$A0$8A$65$A1$85
$A1$18$68$65$A0$85$A0$90$CD$E6$A1$38
$B0$C8$A5$A5$F0$0D$38$A9$00$E5$A0$85
$A0$A9$00$E5$A1$85$A1$60]

PROC _DOINPT=*()
[$86$A4$84$A5$20 _LODCHN $18$A5$A4$69
$01$9D$44$03$A5$A5$69$00$9D$45$03$A5
$A3$F0$18$9D$48$03$A9$00$9D$49$03$A9
$05$9D$42$03$20 _GOCIO $BD$48$03$F0
$03$38$E9$01$A0$00$91$A4$A5$A6$F0$07
$A5$A4$A6$A5$4C ValC $60]

BYTE FUNC InputBD=*(BYTE d)
CARD FUNC InputCD=*(BYTE d)
;INT FUNC InputID=*(BYTE d)
[$48$A9$78$85$A3$A9$01$85$A6$68$A2$FD
$A0$03$4C _DOINPT]

;BYTE FUNC InputB=*()
;CARD FUNC InputC=*()
;INT FUNC InputI=*()
;[$AD _DEVIC$4C InputCD]

;PROC InputMD=*(BYTE d CARD s BYTE l)
;[$48$A9$00$85$A6$68$4C _DOINPT]

;PROC InputSD=*(BYTE d CARD s)
;[$48$A9$FF$85$A3$68$4C InputMD]

;PROC InputS=*(CARD s)
;[$20 _SHFTR $4C InputSD]

;CHAR FUNC GetD=*(BYTE d)
;[$20 _LODCHN $A9$00$9D$48$03
;$9D$49$03$A9$07$9D$42$03$20 _GOCIO
;$85$A0$60]

PROC Open=*(BYTE d CARD s BYTE m, a)
[$86$A1$20 _LODCHN $A5$A1$20
_STONAM $A5$A3$9D$4A$03$A5$A4$9D$4B
$03$A9$03$9D$42$03$20 _GOCIO $8A$4A
$4A$4A$4A$AA$A9$00$9D$C0$05$60]

PROC Close=*(BYTE d)
[$20 _LODCHN $A9$0C$9D$42$03$20
_GOCIO $60]

;PROC XIO=*(BYTE d,z,c,a1,a2 CARD s)
;[$20 _LODCHN $98$9D$42$03$A5$A3$9D$4A
;$03$A5$A4$9D$4B$03$A5$A5$A4$A6$20
;_STONAM $20 _GOCIO $60]

;PROC Note=*(BYTE d CARD s, o)
;[$86$A1$84$A2$20 _LODCHN $A9$26$9D$42
;$03$20 _GOCIO $A0$00$BD$4C$03$91$A1
;$BD$4E$03$91$A3$BD$4D$03$C8$91$A1$60]

;PROC Point=*(BYTE d CARD s BYTE o)
;[$86$A1$20 _LODCHN $A5$A1$9D$4C$03$98
;$9D$4D$03$A5$A3$9D$4E$03$A9$25$9D$42
;$03$20 _GOCIO $60]

PROC Graphics=*(BYTE m)
[$48$A2$60$A9$0C$9D$42$03$20$56$E4$68
$9D$4B$03$49$10$09$0C$9D$4A$03$A9$53
$85$A0$A9$3A$85$A1$A9$A0$9D$44$03$A9
$00$9D$45$03$A9$03$9D$42$03$20 _GOCIO
$60]

;PROC SetColor=*(BYTE r, h, l)
;[$C9$05$B0$13$85$A0$8A$0A$0A$0A$0A$85
;$A1$98$29$0F$05$A1$A6$A0$9D$C4$02$60]

PROC Position=*(CARD x BYTE y)
[$85$55$86$56$84$54$60]

;PROC Plot=*(CARD x BYTE y)
;[$20 Position $A9$06$AE$FD$02$4C
;PutD]

;PROC DrawTo=*(CARD x BYTE y)
;[$20 Position $A2$60$A9$11
;$9D$42$03$AD$FB$02$8D$FD$02$20 _GOCIO
;$60]

;PROC Fill=*(CARD x BYTE y)
;[$20 Position $A2$60$A9$12
;$9D$42$03$AD$FB$02$8D$FD$02$20 _GOCIO
;$60]

;BYTE FUNC Locate=*(CARD x BYTE y)
;[$20 Position $A9$06$4C GetD]

PROC Sound=*(BYTE c, p, d, v)
[$C9$04$B0$25$86$A1$0A$AA$A9$00$8D$08
$D2$A9$03$8D$0F$D2$A5$A3$29$0F$85$A3
$98$29$0E$0A$0A$0A$0A$05$A3$9D$01$D2
$A5$A1$9D$00$D2$60]

;PROC SndRst=*()
;[$A9$00$A2$07$9D$00$D2$CA$10$FA$60]

;BYTE FUNC Paddle=*(BYTE p)
;[$29$07$AA$BD$70$02$85$A0$60]

;BYTE FUNC PTrig=*(BYTE p)
;[$29$07$AA$BD$7C$02$85$A0$60]

;BYTE FUNC Stick=*(BYTE p)
;[$29$03$AA$BD$78$02$85$A0$60]

;BYTE FUNC STrig=*(BYTE p)
;[$29$03$AA$BD$84$02$85$A0$60]

;INT FUNC SCompare=*(CARD s1, s2)
;[$85$A4$86$A5$84$A2$A0$00$84$A0$84$A1
;$B1$A4$85$A6$B1$A2$85$A7$C4$A6$F0$15
;$C4$A7$F0$11$C8$B1$A4$D1$A2$F0$F1$90
;$03$E6$A0$60$C6$A0$C6$A1$60$A5$A6$C5
;$A7$F0$F9$B0$F0$90$F1]

PROC SCopy=*(CARD d, s)
[$85$A0$86$A1$84$A2$A0$00$B1$A2$A8$B1
$A2$91$A0$C0$00$F0$04$88$38$B0$F4$60]

;PROC SCopyS=*(CARD d, s BYTE b, e)
;[$85$A0$86$A1$84$A2$A0$00$84$A6$B1$A2
;$C5$A5$B0$02$85$A5$A5$A4$F0$15$C5$A5
;$F0$02$B0$0F$A4$A4$E6$A4$B1$A2$E6$A6
;$A4$A6$91$A0$38$B0$E7$A5$A6$A0$00$91
;$A0$60]

;PROC SAssign=*(CARD d, s BYTE b, e)
;[$85$A0$86$A1$84$A2$A5$A4$F0$3B$C5$A5
;$F0$02$B0$35$85$A7$C6$A7$A0$00$84$A8
;$B1$A0$85$A9$B1$A2$85$AA$A5$A7$C5$A5
;$B0$15$A5$A8$C5$AA$B0$0F$E6$A8$A4$A8
;$B1$A2$E6$A7$A4$A7$91$A0$38$B0$E5$A5
;$A7$C5$A9$90$04$A0$00$91$A0$60]

BYTE FUNC Rand=*(BYTE r)
[$85$A2$C6$A2$A9$01$C5$A2$B0$05$38$2A
$38$B0$F7$85$A3$AD$0A$D2$25$A3$C5$A2
$F0$04$90$02$B0$F3$85$A0$60]

PROC Poke=*(CARD a BYTE v)
[$85$A0$86$A1$98$A0$00$91$A0$60]

PROC PokeC=*(CARD a, v)
[$20 Poke $C8$A5$A3$91$A0$60]

;BYTE FUNC Peek=*(CARD a)
CARD FUNC PeekC=*(CARD a)
[$85$A2$86$A3$A0$00$B1$A2$85$A0$C8$B1
$A2$85$A1$60]

PROC SetBlock=*(CARD a, l, v)
[$85$A0$86$A1$84$A2$A0$00$A5$A2$D0$04
$A5$A3$F0$16$A5$A4$91$A0$C8$D0$02$E6
$A1$C6$A2$A5$A2$C9$FF$D0$E7$C6$A3$38
$B0$E2$60]

PROC Zero=*(CARD a, l)
[$48$A9$00$85$A4$68$4C SetBlock]

PROC MoveBlock=*(CARD d, s, l)
[133 160 134 161 132 162 160   0 166
165 240  14 177 162 145 160 200 208
249 230 163 230 161 202 208 242 166
164 240   8 177 162 145 160 200 202
208 248  96]

MODULE

Gem Drop - Source Code

GEMINTRO.ACT

GEMINC.ACT

GEMDROP.ACT

GEMRT.ACT