' LOSE YOUR MARBLES
'
' AN ISOMETRIC 3D PLATFORM GAME
'
' WRITTEN ENTIRELY ON AN IPHONE!
'
' CODE & GRAPHICS COPYRIGHT (C) 2019 NAT PRYCE
' LICENSE: CC BY-NC-SA 4.0

' TODO
' - DON'T DRAW OFFSCREEN ACTORS
' - WARP OUT ANIMATION ON LEVEL COMPLETION
' - SCROLLING
' - MORE LEVELS!
' - MORE ENEMIES & OBSTACLES
' -- CHASE THE PLAYER
' - CUSTOM FONT

GLOBAL TRUE, FALSE
TRUE = -1
FALSE = 0

GLOBAL NONE
NONE = -1

GLOBAL _X, _Y, _Z
_X = 0
_Y = 1
_Z = 2

GLOBAL GRAVITY
GRAVITY = 0.0125

SUB FAIL(FNAME$, MSG$)
  BG 0
  ATTR (,0,0,1)
  SCROLL 0, 0, 0
  
  TEXT 0,1, "ERROR!"
  TEXT 1,2, FNAME$
  TEXT 1,3, MSG$
  END
END SUB


'--------------------------------------------' CENTERED TEXT

DIM GLOBAL TITLE_LINE_OFFSETS(16)


SUB TITLE_INIT
  SPRITE OFF
  CLS
  FOR I = 0 TO 16
    TITLE_LINE_OFFSETS(I) = 0
  NEXT I
  
  ON RASTER CALL TITLE_CENTER_LINES
END SUB


SUB TITLE_CENTER_LINES
  L = RASTER/8
  SCROLL 0, TITLE_LINE_OFFSETS(L), 0
END SUB


SUB TITLE_END
  ON RASTER OFF
END SUB


SUB CTEXT(Y, L$)
  BG 0
  BG FILL 0, Y TO 19, Y CHAR 0
  TEXT 0, Y, L$
  TITLE_LINE_OFFSETS(Y) = -(20-LEN(L$))*4
  Y = Y + 1
END SUB


SUB BLANK(Y)
  Y = Y + 1
END SUB


SUB CLT(Y)
  BG 0
  BG FILL 0, Y TO 19, Y CHAR 0
  TITLE_LINE_OFFSETS(Y) = 0
  Y = Y + 1
END SUB



'--------------------------------------------
' ISOMETRIC 3D PROJECTION


SUB ISO(P3(), SCR())
  ' ISOMETRIC PROJECTION OF A POINT IN
  ' 3D WORLD COORDINATES TO A POINT IN
  ' 2D VIRTUAL SCREEN COORDINATES
  
  CALL ISOC(P3(_X), P3(_Y), P3(_Z), SCR())
END SUB


SUB ISOE(A(), I, SCR())
  ' ISOMETRIC PROJECTION OF A WORLD POINT
  ' THAT IS A SLICE IN A MULTIDIMENSIONAL
  ' ARRAY
  
  CALL ISOC(A(I,_X),A(I,_Y),A(I,_Z), SCR())
END SUB


SUB ISOC(X,Y,Z, SCREEN())
  ' ISOMETRIC PROJECTION WITH EACH WORLD
  ' COORDINATE PASSED INDIVIDUALLY
  
  SCREEN(_X) = X*8
  SCREEN(_Y) = 4*Z - 8*Y
END SUB



'--------------------------------------------
' DEFORMABLE 2D MAP STORED IN WORKING MEMORY

TILE_MAX = 4
DIM GLOBAL TILE_FRICTION(TILE_MAX)
DIM GLOBAL TILE_HARDNESS(TILE_MAX)

DEFAULT_FRICTION = 0.025
DEFAULT_HARDNESS = 1

TILE_FRICTION(1) = DEFAULT_FRICTION
TILE_HARDNESS(1) = DEFAULT_HARDNESS
TILE_FRICTION(2) = DEFAULT_FRICTION
TILE_HARDNESS(2) = DEFAULT_HARDNESS
TILE_FRICTION(3) = DEFAULT_FRICTION
TILE_HARDNESS(3) = DEFAULT_HARDNESS
TILE_FRICTION(4) = DEFAULT_FRICTION*6
TILE_HARDNESS(4) = DEFAULT_HARDNESS/6


GLOBAL MAP_WIDTH
GLOBAL MAP_DEPTH
GLOBAL MAP_END_ADDR
GLOBAL START_X, START_Z


SUB MAP_INIT(W, D)
  MAP_WIDTH = W
  MAP_DEPTH = D
  FILL $A000, W*D, 0
  MAP_END_ADDR = $A000 + W*D
END SUB


SUB MAP_ADDR(X, Z, AOUT)
  AOUT = $A000 + MAP_WIDTH*INT(Z) + INT(X)
END SUB


SUB MAP_GET(X, Z, VOUT)
  IF X<0 OR X>=MAP_WIDTH THEN
    VOUT = 0
  ELSE IF Z<0 OR Z>=MAP_DEPTH THEN
    VOUT = 0
  ELSE
    A = NONE
    CALL MAP_ADDR(X, Z, A)
    VOUT = PEEK(A)
  END IF
END SUB


SUB MAP_GET_PATCH(X, Z, PATCH())
  FOR DZ = 0 TO 3
    FOR DX = 0 TO 2
      PX = X-1+DX
      PZ = Z-1+DZ
      CALL MAP_GET(PX, PZ, PATCH(DX,DZ))
    NEXT DX
  NEXT DZ
END SUB


SUB MAP_SET(X, Z, V)
  A = -1
  CALL MAP_ADDR(X, Z, A)
  POKE A, V
END SUB


SUB MAP_SETRECT(MINX, MINZ, MAXX, MAXZ, V)
  FOR X = MINX TO MAXX
    FOR Z = MINZ TO MAXZ
      CALL MAP_SET(X, Z, V)
    NEXT Z
  NEXT X
END SUB



'--------------------------------------------
' DRAW THE MAP

SUB MAP_DRAW
  'DISPLAY (,0,0,,)
  
  CALL MAP_DRAW_OFFSCREEN
  
  BG 1
  BG COPY 0,0, 20,16 TO 0,0

  'DISPLAY (,1,1,,)
END SUB


SUB MAP_DRAW_OFFSCREEN
  BG SOURCE MAP_END_ADDR,MAP_WIDTH,MAP_DEPTH
  
  ATTR (,,,1,)
  
  FOR X = 0 TO MAP_WIDTH-1
    FOR Z = 0 TO MAP_DEPTH-2 STEP 2
      C = 0
      A = 0
      CALL MAP_GET_TILE(X, Z, C, A)
      
      ATTR (A)
      MCELL X, Z\2, C
    NEXT Z
  NEXT X
END SUB


SUB MAP_GET_TILE(X, Z, C, A)
  DIM P(2,3)
  CALL MAP_GET_PATCH(X, Z, P())
  
  IF P(1,1)=0 AND P(1,2)=0 THEN
    A = 0
    CALL MAP_TILE_SPACE(P(), C)
  ELSE IF P(1,1)=0 AND P(1,2)=1 THEN
    A = 0
    CALL MAP_TILE_LOWER_HALF(P(), C)
  ELSE IF P(1,1)=1 AND P(1,2)=0 THEN
    A = 0
    CALL MAP_TILE_UPPER_HALF(P(), C)
  ELSE IF P(1,1)=1 AND P(1,2)=1 THEN
    A = 0
    CALL MAP_TILE_BOTH(P(), C)
  ELSE IF P(1,1)=2 OR P(1,2)=2 THEN
    A = 2
    CALL MAP_TILE_FINISHLINE(P(), C)
  ELSE IF P(1,1)=3 OR P(1,2)=3 THEN
    A = 2
    CALL MAP_TILE_SPIKES(P(), C)
  ELSE IF P(1,1)=4 OR P(1,2)=4 THEN
    A = 5
    CALL MAP_TILE_SOFT(P(), C)
  END IF
END SUB



SUB MAP_TILE_SPACE(P(), C)
  IF P(1,0) <> 0 THEN
    IF P(0,0)<>0 AND P(2,0)<>0 THEN
      C=17
    ELSE IF P(0,0)<>0 THEN
      C=21
    ELSE IF P(2,0)<>0 THEN
      C=20
    END IF
  ELSE
    C = 0
  END IF
END SUB


SUB MAP_TILE_BOTH(P(), C)
  IF P(1,3) = 0 THEN
    IF P(0,2)=0 AND P(0,3)=0 THEN
      C = 4
    ELSE IF P(2,2)=0 AND P(2,3)=0 THEN
      C = 5
    ELSE
      C = 1
    END IF
  ELSE IF P(1,0) = 0 THEN
    IF P(0,0)=0 AND P(0,1)=0 THEN
      C = 2
    ELSE IF P(2,0)=0 AND P(2,1)=0 THEN
      C = 3
    ELSE
      C = 1
    END IF
  ELSE
    C = 1
  END IF
END SUB


SUB MAP_TILE_LOWER_HALF(P(), C)
  IF P(0,1)=0 AND P(0,2)=0 THEN
    C = 9
  ELSE IF P(2,1)=0 AND P(2,2)=0 THEN
    C = 11
  ELSE
    C = 10
  END IF
END SUB


SUB MAP_TILE_UPPER_HALF(P(), C)
  IF P(0,1)=0 AND P(0,2)=0 THEN
    C = 6
  ELSE IF P(2,1)=0 AND P(2,2)=0 THEN
    C = 8
  ELSE
    C = 7
  END IF
END SUB


SUB MAP_TILE_FINISHLINE(P(), C)
  CALL MAP_TILE_SURFACE(P(), 32, C)
END SUB


SUB MAP_TILE_SPIKES(P(), C)
  CALL MAP_TILE_SURFACE(P(), 35, C)
END SUB


SUB MAP_TILE_SOFT(P(), C)
  
  CALL MAP_TILE_SURFACE(P(), 38, C)
END SUB


SUB MAP_TILE_SURFACE(P(), BASEC, C)
  IF P(1,1)=1 THEN
    C=BASEC+2
  ELSE IF P(1,2)=1 THEN
    C=BASEC+1
  ELSE
    C=BASEC
  END IF
END SUB



'--------------------------------------------
' DYNAMICALLY ALLOCATED ACTORS
'
' 0                      = THE PLAYER'S BALL
' 1..ENEMY_MAX           = ENEMIES
' ENEMY_MAX+1..ACTOR_MAX = PARTICLES


GLOBAL ACTOR_MAX
ACTOR_MAX = 31

DIM GLOBAL ACTOR_TYPE(ACTOR_MAX)
DIM GLOBAL ACTOR_NEXT(ACTOR_MAX)
DIM GLOBAL ACTOR_PREV(ACTOR_MAX)
DIM GLOBAL ACTOR_P(ACTOR_MAX, 2)
DIM GLOBAL ACTOR_V(ACTOR_MAX, 2)
DIM GLOBAL ACTOR_RADIUS(ACTOR_MAX)

DIM GLOBAL ACTOR_FRAME(ACTOR_MAX)
DIM GLOBAL ACTOR_COLOR(ACTOR_MAX)
DIM GLOBAL ACTOR_SHADOW(ACTOR_MAX)

GLOBAL ACTORS_LIVE
GLOBAL ACTORS_FREE

' ACTOR TYPES

GLOBAL T_BALL
T_BALL = 1

GLOBAL T_ROBOT_NS
T_ROBOT_NS = 2

GLOBAL T_ROBOT_EW
T_ROBOT_EW = 3

' PARTICLE AFFECTED BY GRAVITY
GLOBAL T_GPARTICLE
T_GPARTICLE = 4


SUB ACTOR_INIT
  SPRITE OFF
  
  ACTOR_PREV(0) = NONE
  FOR A = 1 TO ACTOR_MAX
    ACTOR_NEXT(A-1) = A
    ACTOR_PREV(A) = A-1
  NEXT A
  ACTOR_NEXT(ACTOR_MAX) = NONE
  
  ACTORS_LIVE = NONE
  ACTORS_FREE = 0
END SUB


SUB ACTOR_ADD(LIST, A)
  ACTOR_NEXT(A) = LIST
  IF LIST <> NONE THEN
    ACTOR_PREV(LIST) = A
  END IF
  LIST = A
END SUB


SUB ACTOR_UNLINK(LIST, A)
  IF LIST < 0 THEN
    CALL FAIL("ACTOR_UNLINK", "LIST EMPTY")
  END IF
  
  N = ACTOR_NEXT(A)
  P = ACTOR_PREV(A)
  
  IF N >= 0 THEN
    ACTOR_PREV(N) = P
  END IF
  
  IF P >= 0 THEN
    ACTOR_NEXT(P) = N
  ELSE
    LIST = N
  END IF
  
  ACTOR_PREV(A) = NONE
  ACTOR_NEXT(A) = NONE
END SUB


SUB ACTOR_ALLOC(TYPE, A)
  A = ACTORS_FREE
  CALL ACTOR_UNLINK(ACTORS_FREE, A)
  CALL ACTOR_ADD(ACTORS_LIVE, A)
  ACTOR_TYPE(A) = TYPE
END SUB


SUB ACTOR_RELEASE(A)
  CALL ACTOR_UNLINK(ACTORS_LIVE, A)
  CALL ACTOR_ADD(ACTORS_FREE, A)
  SPRITE OFF A
END SUB


SUB SORT(REFS(), N, ROWS(), SORTCOL)
  I = 1
  WHILE I < N
    J = I
    DO
       IF J <= 0 THEN 
         GOTO ENDINSERT
       END IF
       
       A = ROWS(REFS(J-1), SORTCOL)
       B = ROWS(REFS(J), SORTCOL)
       
       IF A >= B THEN 
         GOTO ENDINSERT
       END IF
       
       SWAP REFS(J), REFS(J-1)
       J = J - 1
    LOOP
    
    ENDINSERT:
    
    I = I + 1
  WEND
END SUB


SUB ACTORS_TO_ARRAY(ARR(), COUNT)
  A = ACTORS_LIVE
  COUNT = 0
  WHILE A <> NONE
    ARR(COUNT) = A
    A = ACTOR_NEXT(A)
    COUNT = COUNT + 1
  WEND
END SUB


SUB DRAW_ACTORS
  DIM ORDER(ACTOR_MAX)
  COUNT=0
  CALL ACTORS_TO_ARRAY(ORDER(), COUNT)
  
  CALL SORT(ORDER(), COUNT, ACTOR_P(), _Z)
  
  SPRITE OFF
  
  S = 0
  DIM P2(1)
  FOR I = 0 TO COUNT-1
    A = ORDER(I)
    
    AX = ACTOR_P(A,_X)
    AY = ACTOR_P(A,_Y)
    AZ = ACTOR_P(A,_Z)
    AC = ACTOR_COLOR(A)
    AF = ACTOR_FRAME(A)
    
    CALL ISOC(AX, AY, AZ, P2())
    
    PRIORITY = 0 - (AY >= 0)
    
    SPRITE S, P2(_X)-4, P2(_Y)-4, AF
    SPRITE.A S, (AC,,,PRIORITY,)
    S = S + 1
    
    IF ACTOR_SHADOW(A) AND AY >= 0 THEN
      IF TIMER MOD 2 = 0 THEN
        CALL ISOC(AX, 0, AZ, P2())
        SPRITE S, P2(_X)-4, P2(_Y)-4, AF+16
        SPRITE.A S, (6,,,1,)
        S = S + 1
      END IF
    END IF
  NEXT I
END SUB


SUB ACTOR_ANIM(A, BASE, NFRAMES, FRAMET)
  F = (GTIMER/FRAMET) MOD NFRAMES
  ACTOR_FRAME(A) = BASE + F
END SUB


SUB ACTOR_SETPOS(A, X, Y, Z)
  ACTOR_P(A,_X) = X
  ACTOR_P(A,_Y) = Y
  ACTOR_P(A,_Z) = Z
END SUB


SUB ACTOR_SETVEL(A, X, Y, Z)
  ACTOR_V(A,_X) = X
  ACTOR_V(A,_Y) = Y
  ACTOR_V(A,_Z) = Z
END SUB


SUB ACTOR_MOVEV(A)
  FOR I = 0 TO 2
    ACTOR_P(A,I) = ACTOR_P(A,I)+ACTOR_V(A,I)
  NEXT I
END SUB


SUB ACTOR_ACCEL(A, DX, DY, DZ)
  ACTOR_V(A,_X) = ACTOR_V(A,_X) + DX
  ACTOR_V(A,_Y) = ACTOR_V(A,_Y) + DY
  ACTOR_V(A,_Z) = ACTOR_V(A,_Z) + DZ
END SUB


SUB ACTOR_MOVE_ALL
  A = ACTORS_LIVE
  
  WHILE A <> NONE
    NEXTA = ACTOR_NEXT(A)
    
    ISDONE = FALSE
    CALL ACTOR_MOVE(A, ISDONE)
    IF ISDONE THEN CALL ACTOR_RELEASE(A)
    
    A = NEXTA
  WEND
END SUB


SUB ACTOR_MOVE(A, ISDONE)
  TYPE = ACTOR_TYPE(A)
  
  IF TYPE = T_BALL THEN
    CALL BALL_MOVE(A)
  ELSE IF TYPE = T_ROBOT_NS THEN
    CALL ROBOT_MOVE(A)
  ELSE IF TYPE = T_ROBOT_EW THEN
    CALL ROBOT_MOVE(A)
  ELSE IF TYPE = T_GPARTICLE THEN
    CALL GPARTICLE_MOVE(A, ISDONE)
  ELSE
    BG 1
    ATTR (0,0,0,1)
    TEXT 0,0, "UNKNOWN ACTOR TYPE" + STR$(A)
    END
  END IF
END SUB


SUB ACTOR_TRACE(A)
  BG 0
  ATTR (7)
  X = ACTOR_P(A,_X)
  Y = ACTOR_P(A,_Y)
  Z = ACTOR_P(A,_Z)   
   
  C = NONE
  CALL MAP_GET(X, Z, C)
  
  BG FILL 0,0 TO 15,3 CHAR 0
  TEXT 0,0,"X:"+STR$(X)
  TEXT 0,1,"Y:"+STR$(Y)
  TEXT 0,2,"Z:"+STR$(Z)
  ADDR = NONE
  CALL MAP_ADDR(X, Z, ADDR)
  TEXT 0,3,"A:"+HEX$(ADDR)
END SUB


'--------------------------------------------
' ENEMIES

SUB ROBOT_NEW(TYPE, X, Z)
  A = NONE
  CALL ACTOR_ALLOC(TYPE, A)
  ACTOR_RADIUS(A) = 0.5
  CALL ACTOR_SETPOS(A, X, ACTOR_RADIUS(A), Z)
  ACTOR_FRAME(A) = 65
  ACTOR_COLOR(A) = 3
  ACTOR_SHADOW(A) = TRUE
  
  SPEED = 1/16
  
  IF TYPE = T_ROBOT_NS THEN
    CALL ACTOR_SETVEL(A, 0, 0, SPEED)
  ELSE IF TYPE = T_ROBOT_EW THEN
    CALL ACTOR_SETVEL(A, SPEED, 0, 0)
  ELSE
    CALL FAIL("ROBOT_NEW", STR$(TYPE))
  END IF
END SUB


SUB ROBOT_MOVE(A)
  TYPE = ACTOR_TYPE(A)
  
  X = ACTOR_P(A,_X)
  Z = ACTOR_P(A,_Z)
  
  VX = ACTOR_V(A,_X)
  VZ = ACTOR_V(A,_Z)
  
  ' REVERSE AT EDGE OF PLATFORM
  MX = X + SGN(VX)/2
  MZ = Z + SGN(VZ)/2
  C = NONE
  CALL MAP_GET(MX, MZ, C)

  IF C = 0 THEN
    ACTOR_V(A,_X) = VX * -1
    ACTOR_V(A,_Z) = VZ * -1
  END IF
  
  CALL ACTOR_MOVEV(A)
  CALL ACTOR_ANIM(A, 65, 3, 10)
END SUB


'--------------------------------------------
' PARTICLES

SUB GPARTICLE_NEW(A)
  CALL ACTOR_ALLOC(T_GPARTICLE, A)
  ACTOR_RADIUS(A) = 0
  ACTOR_FRAME(A) = 96
  ACTOR_SHADOW(A) = TRUE
END SUB


SUB GPARTICLE_MOVE(A, ISDONE)
  CALL ACTOR_MOVEV(A)
  IF ACTOR_P(A,_Y) <= 0 THEN
    ISDONE = TRUE
    EXIT SUB
  END IF
  
  IF RND < 0.05 THEN
    ACTOR_FRAME(A) = ACTOR_FRAME(A)+1
    IF ACTOR_FRAME(A) > 98 THEN
      ISDONE = TRUE
      EXIT SUB
    END IF
  END IF
  
  CALL ACTOR_ACCEL(A, 0, -GRAVITY/4, 0)
END SUB


'--------------------------------------------
' BALL

GLOBAL BALL
GLOBAL BALL_STARTED
GLOBAL BALL_FALLEN

SUB BALL_NEW(A)
  CALL ACTOR_ALLOC(T_BALL, A)
  ACTOR_RADIUS(A) = 0.5
  ACTOR_COLOR(A) = 1
  ACTOR_FRAME(A) = 64
  ACTOR_SHADOW(A) = TRUE
  BALL_STARTED = 0
END SUB


SUB BALL_LAUNCH(A)
  CALL ACTOR_SETPOS(A, START_X, 8, START_Z)
  
  ACTOR_V(A,_X) = 0
  ACTOR_V(A,_Y) = 0
  ACTOR_V(A,_Z) = 0
  
  BALL_FALLEN = FALSE
END SUB


SUB BALL_MOVE(A)
  CALL ACTOR_MOVEV(A)
  
  PX = ACTOR_P(A,_X)
  PY = ACTOR_P(A,_Y)
  PZ = ACTOR_P(A,_Z)
  
  ' BOTTOM OF THE BALL
  BY = PY - ACTOR_RADIUS(A)
  
  VY = ACTOR_V(A,_Y)
  
  C = -1
  CALL MAP_GET(INT(PX), INT(PZ), C)
  
  TF = TILE_FRICTION(C)
  TH = TILE_HARDNESS(C)
  
  ROLLING=BY<0.05 AND ABS(VY)<0.05 AND C<>0
  
  IF ROLLING THEN
    IF C = 3 THEN
      CALL EXPLODE(A)
      CALL BALL_LAUNCH(A)
    ELSE
      ACTOR_P(A,_Y) = ACTOR_RADIUS(A)
      ACTOR_V(A,_Y) = 0
    
      ' APPLY SURFACE FRICTION
      CALL APPLY_FRICTION(A, TF)
      CALL CONTROL_BALL(A, TH)
    END IF
  ELSE
    IF BY < 0 THEN
      IF BALL_FALLEN THEN
        IF BY <= -12 THEN 
          CALL BALL_LAUNCH(A)
        END IF
      ELSE
        ' NOT BALL_FALLEN
        
        IF C = 3 THEN
          CALL EXPLODE(A)
          CALL BALL_LAUNCH(A)
          
        ELSE IF C <> 0 THEN
          ' BOUNCE
          ACTOR_P(A,_Y) = PY - 2*BY
          ACTOR_V(A,_Y) = VY * -0.6 * TH
          
          ' APPLY SURFACE & ELASTIC FRICTION
          CALL APPLY_FRICTION(A, TF*5)
          CALL CONTROL_BALL(A, TH)
      
        ELSE
          BALL_FALLEN = TRUE
        END IF
      END IF
    END IF
    
    CALL ACTOR_ACCEL(A, 0, -GRAVITY, 0)
  END IF
END SUB


SUB APPLY_FRICTION(A, COEFF)
  VX = ACTOR_V(A,_X)
  VZ = ACTOR_V(A,_Z)
  V = SQR(VX^2 + VZ^2)
  IF V = 0 THEN EXIT SUB
  
  F = COEFF * V
  
  ' EMERGENCY BRAKE
  IF BUTTON(0,1) THEN
    F = F * 5
  END IF
  
  ' UNIT VECTOR
  UX = VX / V
  UZ = VZ / V
  
  CALL ACTOR_ACCEL(A, -UX*F, 0, -UZ*F)
END SUB


SUB CONTROL_BALL(A, TILE_HARDNESS)
  DX = LEFT(0) - RIGHT(0)
  DZ = UP(0) - DOWN(0)
  
  THRUST = 0.005
  CALL ACTOR_ACCEL(A, DX*THRUST, 0, DZ*THRUST)
  
  ' JUMP
  IF BUTTON(0,0) THEN
    ACTOR_V(A,_Y) = 0.25 * TILE_HARDNESS
  END IF
  
  IF BALL_STARTED = 0 THEN
    IF DX OR DZ OR BUTTON(0) THEN
      BALL_STARTED = GTIMER
      CALL CLEAR_TIP
    END IF
  END IF
END SUB


SUB BALL_AT_END(A, RESULT)
  X = ACTOR_P(A,_X)
  Y = ACTOR_P(A,_Y) - ACTOR_RADIUS(A)
  Z = ACTOR_P(A,_Z)
  VY = ACTOR_V(A,_Y)
  
  ROLLING = Y=0 AND VY=0
    
  C = NONE
  CALL MAP_GET(X, Z, C)
  
  RESULT = (C = 2 AND ROLLING)
END SUB


'--------------------------------------------
' LEVELS

GLOBAL LEVEL_TIP_MAX
LEVEL_TIP_MAX = 3
DIM GLOBAL LEVEL_TIP$(LEVEL_TIP_MAX)


SUB FLOOR(MINX, MINY, MAXX, MAXY)
  CALL MAP_SETRECT(MINX, MINY, MAXX, MAXY, 1)
END SUB

SUB FINISH(MINX, MINY, MAXX, MAXY)
  CALL MAP_SETRECT(MINX, MINY, MAXX, MAXY, 2)
END SUB

SUB SPIKES(MINX, MINY, MAXX, MAXY)
  CALL MAP_SETRECT(MINX, MINY, MAXX, MAXY, 3)
END SUB

SUB SOFT(MINX, MINY, MAXX, MAXY)
  CALL MAP_SETRECT(MINX, MINY, MAXX, MAXY, 4)
END SUB

SUB TIP(I, S$)
  LEVEL_TIP$(I) = S$
END SUB

SUB START(X, Z)
  START_X = X
  START_Z = Z
END SUB


SUB LEVEL00
  CALL MAP_INIT(20, 32)
  
  CALL TIP(0, "USE THE GAMEPAD TO")
  CALL TIP(1, "MOVE THE BALL ONTO")
  CALL TIP(2, "THE CHECKERED AREA")
  
  CALL FLOOR(2, 4, 7, 13)
  CALL FLOOR(8, 7, 12, 10)
  CALL FLOOR(13, 4, 18, 13)
  CALL FINISH(17, 4, 17, 13)
  CALL START(3, 5)
END SUB


SUB LEVEL01
  CALL MAP_INIT(20, 32)
  
  CALL TIP(0, "USE BUTTON A")
  CALL TIP(1, "TO JUMP GAPS")
  
  CALL FLOOR(2, 4, 7, 13)
  CALL FLOOR(8, 7, 9, 10)
  CALL FLOOR(11, 7, 12, 10)
  CALL FLOOR(13, 4, 18, 13)
  CALL FINISH(17, 4, 17, 13)
  CALL START(3, 5)
END SUB


SUB LEVEL02
  CALL MAP_INIT(20, 32)
  
  CALL TIP(0, "USE BUTTON B")
  CALL TIP(1, "TO BRAKE")
  
  CALL FLOOR(5, 4, 7, 11)
  CALL FLOOR(2, 18, 4, 25)
  
  CALL FLOOR(8, 7, 16, 8)
  CALL FLOOR(15, 9, 16, 22)
  CALL FLOOR(5, 21, 16, 22)
  
  CALL START(6, 5)
  CALL FINISH(3, 18, 3, 25)
END SUB

SUB LEVEL03
  CALL MAP_INIT(20, 32)
  
  CALL TIP(0, "NOT ALL SURFACES")
  CALL TIP(1, "ARE SAFE")
  
  CALL FLOOR(2, 4, 7, 13)
  CALL FLOOR(8, 6, 12, 11)
  CALL SPIKES(9, 6, 11, 11)
  CALL FLOOR(13, 4, 18, 13)
  CALL FINISH(17, 4, 17, 13)
  CALL START(3, 5)
END SUB

SUB LEVEL04
  CALL MAP_INIT(20, 32)
  
  CALL TIP(0, "AVOID ENEMIES OR")
  CALL TIP(1, "JUMP OVER THEM")
  
  CALL FLOOR(2, 7, 8, 10)
  CALL FLOOR(9, 4, 18, 13)
  CALL FLOOR(13, 14, 15, 22)
  CALL FINISH(13, 21, 15, 21)
  
  CALL ROBOT_NEW(T_ROBOT_NS, 9.5, 4.5)
  CALL ROBOT_NEW(T_ROBOT_EW, 9.5, 13.5)
  
  CALL START(3, 9)
END SUB

SUB LEVEL05
  CALL MAP_INIT(20, 32)
  
  CALL TIP(0, "SOFT GROUND SLOWS")
  CALL TIP(1, "YOU DOWN AND STOPS")
  CALL TIP(2, "YOU BOUNCING")
  
  CALL FLOOR(1, 3, 6, 15)
  CALL FLOOR(7, 5, 7, 7)
  CALL FLOOR(7, 11, 7, 13)
  CALL FLOOR(13, 2, 17, 17)
  CALL SOFT(13, 10, 15, 15)
  CALL FINISH(16, 2, 16, 17)
  CALL START(2, 6.5)
END SUB



SUB LEVEL_INIT(N)
  FOR I = 0 TO LEVEL_TIP_MAX
    LEVEL_TIP$(I) = ""
  NEXT I
  
  IF N = 0 THEN
    CALL LEVEL00
  ELSE IF N = 1 THEN
    CALL LEVEL01
  ELSE IF N = 2 THEN
    CALL LEVEL02
  ELSE IF N = 3 THEN
    CALL LEVEL03
  ELSE IF N = 4 THEN
    CALL LEVEL04
  ELSE IF N = 5 THEN
    CALL LEVEL05
  ELSE
    CALL FAIL("LEVEL", "INVALID: "+STR$(N))
  END IF
END SUB

GLOBAL LEVEL_MAX
LEVEL_MAX = 5

DIM GLOBAL LEVEL_BEST(LEVEL_MAX)
DIM GLOBAL LEVEL_LAST(LEVEL_MAX)



'--------------------------------------------
' MAIN


SUB SHOW_TIP
  BG 0
  ATTR (4)
  FOR I = 0 TO LEVEL_TIP_MAX
    CALL CTEXT(13+I, LEVEL_TIP$(I))
  NEXT I
END SUB


SUB CLEAR_TIP
  FOR I = 0 TO 2
    CALL CLT(13+I)
  NEXT I
END SUB


SUB FORMAT_TIME(T, T$)
  T$ = STR$((T\6)/10)
  IF LEFT$(RIGHT$(T$,2),1)<>"." THEN
    T$ = T$ + ".0"
  END IF
  T$ = T$ + " S"
END SUB


SUB TITLE_SCREEN(STARTL)
  CALL TITLE_INIT
  
  BG 0
  
  ATTR (1)
  CALL CTEXT(1, "LOSE YOUR MARBLES!")
  
  ATTR (4)
  CALL CTEXT(4, "STARTING LEVEL")
  
  ATTR(4)
  CALL CTEXT(13, "PRESS ANY BUTTON")
  CALL CTEXT(14, "TO PLAY")
  
  REPEAT
    ATTR(4)
    CALL CTEXT(6, "< "+STR$(STARTL+1)+" >")
    ATTR (0)
    
    BEST = LEVEL_BEST(STARTL)
    IF BEST > 0 THEN
      BEST$ = ""
      CALL FORMAT_TIME(BEST, BEST$)
      CALL CTEXT(9, "BEST: "+BEST$)
    ELSE
      CALL CTEXT(9, "NO BEST TIME YET")
    END IF
    
    LAST = LEVEL_LAST(STARTL)
    IF LAST > 0 THEN
      LAST$ = ""
      CALL FORMAT_TIME(LAST, LAST$)
      CALL CTEXT(10, "LAST: "+LAST$)
    ELSE
      CALL CLT(10)
    END IF
    
    WAIT VBL
    
    DL = LEFT TAP(0) - RIGHT TAP(0)
    NEXTL = STARTL + LEVEL_MAX + 1 + DL
    STARTL = NEXTL MOD (LEVEL_MAX + 1)
  UNTIL BUTTON TAP(0)
  
  CALL TITLE_END
  CLS
END SUB


SUB MENUITEM(Y, SELECTED, T$)
  IF SELECTED THEN
    ATTR (4)
  ELSE
    ATTR (0)
  END IF
  CALL CTEXT(Y, T$)
END SUB


SUB PAUSE_MENU(OPT)
  SPRITE OFF
  CLS
  
  ATTR(1)
  CALL CTEXT(2, "PAUSED")
  
  OPT = 0
  REPEAT
    CALL MENUITEM(6, OPT=0, "RESUME GAME")
    CALL MENUITEM(8, OPT=1, "RESTART LEVEL")
    CALL MENUITEM(10, OPT=2, "RETURN TO TITLE")
    
    OPT = (OPT+UP TAP(0)-DOWN TAP(0)) MOD 3
    WAIT VBL
  UNTIL BUTTON TAP(0)
  CLS
END SUB


GLOBAL GTIMER


SUB PLAY_LEVEL(N, OPT, TIME)
  CALL TITLE_INIT
  CALL ACTOR_INIT
  
  BALL = NONE
  CALL BALL_NEW(BALL)
  
  CALL LEVEL_INIT(N)
  CALL MAP_DRAW
  CALL SHOW_TIP
  
  MAX_ENEMY = ACTORS_FREE - 1
  LEVEL_COMPLETE = FALSE
  
  CALL BALL_LAUNCH(BALL)
  
  REPEAT
    IF PAUSE THEN
      CALL PAUSE_MENU(OPT)
      IF OPT = 0 THEN
        CALL MAP_DRAW
        IF NOT BALL_STARTED THEN
          CALL SHOW_TIP
        END IF
      ELSE
        EXIT SUB
      END IF
    END IF
    
    IF BALL_STARTED THEN
      TIME = GTIMER - BALL_STARTED
      TIME$ = ""
      CALL FORMAT_TIME(TIME, TIME$)
      ATTR (4,,,1,)
      CALL CTEXT(15, TIME$+"  ")
    END IF
    
    ' ENSURE RANDOM ENEMY BEHAVIOUR IS 
    ' ACTUALLY PREDICTABLE
    RANDOMIZE GTIMER
    
    CALL ACTOR_MOVE_ALL
    CALL CHECK_COLLISIONS(BALL, MAX_ENEMY)
    CALL DRAW_ACTORS
    CALL BALL_AT_END(BALL, LEVEL_COMPLETE)
    
    WAIT VBL
    GTIMER = GTIMER + 1
  UNTIL LEVEL_COMPLETE
END SUB


SUB CHECK_COLLISIONS(BALL, MAX_ENEMY)
  FOR E = BALL+1 TO MAX_ENEMY
    COLLISION = FALSE
    CALL CHECK_COLLISION(BALL, E, COLLISION)
    IF COLLISION THEN
      CALL EXPLODE(BALL)
      CALL BALL_LAUNCH(BALL)
      EXIT SUB
    END IF
  NEXT E
END SUB


SUB EXPLODE(A)
  X = ACTOR_P(A,_X)
  Y = ACTOR_P(A,_Y)
  Z = ACTOR_P(A,_Z)
  
  SPEED = 1/8
  
  WHILE ACTORS_FREE <> NONE
    P = NONE
    CALL GPARTICLE_NEW(P)
    ACTOR_COLOR(P) = ACTOR_COLOR(A)
    CALL ACTOR_SETPOS(P, X, Y, Z)
    
    ' NOT UNIFORMLY DISTRIBUTED BUT
    ' GOOD ENOUGH
    DX = (RND-0.5)*2*SPEED
    DY = (RND-0.5)*2*SPEED
    DZ = (RND-0.5)*2*SPEED
    CALL ACTOR_SETVEL(P, DX, DY, DZ)
  WEND
END SUB


SUB CHECK_COLLISION(A, B, RESULT)
  DX = ACTOR_P(A,_X) - ACTOR_P(B,_X)
  DY = ACTOR_P(A,_Y) - ACTOR_P(B,_Y)
  DZ = ACTOR_P(A,_Z) - ACTOR_P(B,_Z)
  
  D = SQR(DX^2 + DY^2 + DZ^2)
  RA = ACTOR_RADIUS(A)
  RB = ACTOR_RADIUS(B)
  
  RESULT = D <= (RA+RB)
END SUB


SUB WAIT_TAP
  REPEAT
    WAIT VBL
  UNTIL BUTTON TAP(0)
END SUB


SUB PLAY_GAME(START_LEVEL)
  FOR L = START_LEVEL TO LEVEL_MAX
    LEVEL_TIME = 0
    BG FILL 0,0 TO 0, 20 CHAR 0
    
    REPEAT
      OPT = 0
      CALL PLAY_LEVEL(L, OPT, LEVEL_TIME)
    UNTIL OPT <> 1
    IF OPT = 2 THEN EXIT SUB
    
    BG 0
    ATTR (4)
    CALL CTEXT(6, "SUCCESS")
    
    BEST = LEVEL_BEST(L)
    IF BEST = 0 OR LEVEL_TIME < BEST THEN
      CALL CTEXT(8, "BEST TIME!")
      LEVEL_BEST(L) = LEVEL_TIME
    END IF
    LEVEL_LAST(L) = LEVEL_TIME
    
    CALL CTEXT(12, "PRESS ANY BUTTON")
    
    REPEAT
      CALL DRAW_ACTORS
      WAIT VBL
    UNTIL BUTTON TAP(0)
    CLS 0
  NEXT L
  
  CALL CTEXT(7, "THAT'S ALL FOLKS!")
  CALL WAIT_TAP
END SUB


GAMEPAD 1
PAUSE OFF

START_LEVEL = 0
DO
  CALL TITLE_SCREEN(START_LEVEL)
  CALL PLAY_GAME(START_LEVEL)
LOOP



#1:MAIN PALETTES
002D1814003F3020003F1815003F2A15
002F1B0600392410003F1500003F2A15

#2:MAIN CHARACTERS
00000000000000000000000000000000
0000000000000000FFFFFFFFFFFFFFFF
00000000000000007FFFFFFFFFFFFFFF
0000000000000000FEFFFFFFFFFFFFFF
0000000000000080FFFFFFFFFFFFFFFF
0000000000000001FFFFFFFFFFFFFFFF
00000080FF7F0000FFFFFFFFFF7F0000
00000000FFFF0000FFFFFFFFFFFF0000
00000001FFFE0000FFFFFFFFFFFE0000
0000000000000000000000007FFFFFFF
000000000000000000000000FFFFFFFF
000000000000000000000000FEFFFFFF
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
FFFF000000000000FFFF000000000000
00000000000000000000000000000000
00000000000000000000000000000000
FF7F000000000000FF7F000000000000
FFFE000000000000FFFE000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
FFFFFFFFFFFFFFFF0F0FF0F00F0FF0F0
FFFFFFFF000000000F0FF0F0FFFFFFFF
00000000FFFFFFFFFFFFFFFF0F0FF0F0
888822228888222277FFDDFF77FFDDFF
888822220000000077FFDDFFFFFFFFFF
0000000088882222FFFFFFFF77FFDDFF
AA005500AA00550077FFBBFF77FFEEFF
AA0055000000000077FFBBFFFFFFFFFF
00000000AA005500FFFFFFFF77FFEEFF
3CFFFF3C00000000FFFFFFFFFFFFFFFF
000000003CFFFF3CFFFFFFFFFFFFFFFF
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
0030614303071E3C3C4E9FBFFFFF7E3C
0C3663835F0600003C4E9FFFFF7E0000
0C3663036F0600003C4E9FFFFF7E0000
0C366383370600003C4E9FFFFF7E0000
7EFFFF7FA743A742000000815FBF5F3E
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00007EFFFF7E000000007EFFFF7E0000
00007EFFFF7E000000007EFFFF7E0000
00007EFFFF7E000000007EFFFF7E0000
00007EFFFF7E000000007EFFFF7E0000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00001028100000000000103810000000
00000018180000000000001818000000
00000010000000000000001000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000038000000000000003800000000
00000000180000000000000018000000
00000000100000000000000010000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
00000000000000000000000000000000
183C3C3C3C183C181824242424182418
6CFEFE7E240000006C92925A24000000
247EFF7E7EFF7E24245A815A5A815A24
083E7F7E3F7F3E080836414631413608
62F7FE7C3E7FEF4662959A742E59A946
1C3E7E7EFFFE7F3A1C224A46919A453A
183C3C78300000001824244830000000
0C1E3C78783C1E0C0C1224484824120C
30783C1E1E3C78303048241212244830
00247E7EFF7E7E2400245A6681665A24
00183C7EFF7E3C180018246681662418
000000183C3C78300000001824244830
0000007EFF7E00000000007E817E0000
00000000183C3C180000000018242418
060F1E3C78F0E040060912244890A040
3C7EFFFFFFFF7E3C3C4299918999423C
183C7C3C3C7EFF7E182444242466817E
3C7EFF7E3C7EFF7E3C429972244E817E
3C7EFF7E6FFF7E3C3C4299726999423C
66FFFFFF7F0F0F066699998179090906
7EFFFEFE7F7FFE7C7E819E827979827C
1C3E7CFEFFFF7E3C1C224C829999423C
7EFF7F1E3C7878307E81791224484830
3C7EFF7EFFFF7E3C3C4299429999423C
3C7EFF7F7FFF7E3C3C4299417999423C
0000183C183C18000000182418241800
0000183C183C78300000182418244830
000C1E3C783C1E0C000C12244824120C
00007EFF7EFF7E0000007E817E817E00
0030783C1E3C78300030482412244830
3C7EFF7E3C183C183C42997224182418
3C7EFFFFFFFE7E3C3C429991919E423C
183C7EFFFFFFFF661824429981999966
7CFEFFFEFFFFFE7C7C8299829999827C
3C7EFFF6F6FF7E3C3C4299969699423C
78FCFEFFFFFEFC787884929999928478
7EFFFEFCF8FEFF7E7E819E84989E817E
7EFFFEFCF8F0F0607E819E8498909060
3C7EFEFFFFFF7E3C3C429E919999423C
66FFFFFFFFFFFF666699998199999966
3C7E3C3C3C3C7E3C3C4224242424423C
1E3F1F0F6FFF7E3C1E2119096999423C
66FFFEFCFCFEFF666699928484929966
60F0F0F0F0FEFF7E60909090909E817E
42E7FFFFFFFFFF6642A5998181999966
66FFFFFFFFFFFF666699898191999966
3C7EFFFFFFFF7E3C3C4299999999423C
7CFEFFFEFCF0F0607C8299829C909060
3C7EFFFFFFFE7F3E3C4299999592413E
7CFEFFFEFCFEFF667C82998284929966
3E7FFE7E3F7FFE7C3E419E423979827C
7EFF7E3C3C3C3C187E81662424242418
66FFFFFFFFFF7E3C669999999999423C
66FFFFFFFF7E3C186699999999422418
66FFFFFFFFFFE742669999818199A542
66FF7E3C7EFFFF666699422442999966
66FFFF7E3C3C3C186699994224242418
7EFF7E3C78FEFF7E7E817224489E817E
3C7E7C78787C7E3C3C424C48484C423C
60F0783C1E0F07026090482412090502
3C7E3E1E1E3E7E3C3C4232121232423C
183C7EFF660000001824429966000000
00000000007EFF7E00000000007E817E