' getslide  started on 10 nov 93
' without the editor
'
' programmed by Seymour Shlien in GFA Basic 3.5 for the Atari St
' 624 Courtenay Avenue
' Ottawa, Ontario
' Canada  K2A  3B5
DIM full_maze|(1500),full_maze_init|(1500)
'
' The state of each cell in the maze is stored in the array full_maze.
' The initial state of the maze is stored in full_maze_init to allow
' restarting the games at a particular level. The codes for representing
' the state of a particular cell are listed below.
'
' full_maze| = 0-15  free space
' full_maze| = 32-95  robot - only 64 robots are allowd.
' full_maze|=96-103 treasures
' full_maze|= 128-254 barriers
' full_maze|= 160 transparent barrier
' full_maze|= 161-170 4-cell barriers
' full_maze|=255 explorer
' free space
' 0 really free
' 1 twice only
' 2 once only
' 3 frictionless
' 4 free space - dot displayed
' 5 twice onley - dot displayed
' 6 once only - dot displayed
' 7 frictionless -dot displayed
' 14 exit
' The dot is not visible when running the maze except after the
' editor was invoked. The dots are used for indicating the solution
' in some of the difficult levels.
'
' cell numbers 32 to 95 are pointers to one of the 64 robots (or bugs)
' which may be used. robot_loc% points back to the cell position
' of the robot; robot_dir% indicates the direction the robot is moving,
' robot_cell% stores the state of the cell to be restored when the
' robot leaves; robot_status% indicates how many times the robot
' will continue to move in the same direction after it has prodded;
' robot_type identifies the kind of robot (eg bird, frog, block etc.)
' robot_*_init describes the state of the robots on initialization
' of the level. robot_type_delay% indicates the length of the pause
' before the robot moves again.
'
DIM robot_loc%(64),robot_dir%(64),robot_cell%(64),robot_status%(64)
DIM robot_loc_init%(64),robot_cell_init%(64)
DIM robot_delay%(64),robot_type%(64)
DIM robot_type_delay%(16)
'
DIM puts$(16)
DIM edit_menu$(5)
DIM cellpat$(70),treasures$(8),bugs$(16)
DIM cell4$(12)
DIM explorer$(4),explorer_shadow$(4)
DIM swytch_status%(4)
' robot_loc% position in full_maze of robot
' robot_dir% current direction of robot
' robot_status% - robot alive or dead
DIM screen1%(8100)
DIM work_screen%(16200)
DIM screen_ptr%(2)
DIM deskcolors%(16)
DIM difficulty$(2),help$(10)
DIM mazeptr%(2)
DIM tabcolor%(16),luts&(16)
DIM s_mfdb%(8),d_mfdb%(8),bltpar%(8)
@read_sound
@dosound
'
' screen management
' To allow smooth scrolling we need four frame memories. Two of the
' frames stored in work_screen hold a graphic representation of the
' entire maze. The other two screens referenced by screen_ptr% display
' the part of the maze on the screen. We need two screens so we can
' write on one while displaying the other. (To avoid flickering).
'
screen_ptr%(0)=VARPTR(screen1%(0))
screen_ptr%(0)=(screen_ptr%(0)+256) AND &HFFFFFF00
screen_ptr%(1)=XBIOS(2)
mazeptr%(0)=VARPTR(work_screen%(0))
mazeptr%(1)=VARPTR(work_screen%(8100))
mazeptr%(0)=(mazeptr%(0)+256) AND &HFFFFFF00
mazeptr%(1)=(mazeptr%(1)+256) AND &HFFFFFF00
' bitblt parameters
s_mfdb%(0)=mazeptr%(0)
s_mfdb%(1)=320
s_mfdb%(2)=200
s_mfdb%(3)=20
s_mfdb%(4)=0
s_mfdb%(5)=4
d_mfdb%(0)=screen_ptr%(0)
d_mfdb%(1)=320
d_mfdb%(2)=200
d_mfdb%(3)=20
d_mfdb%(4)=0
d_mfdb%(5)=4
difficulty$(0)="Kids Level"
difficulty$(1)="Regular Level"
flip%=1 !screen_ptr selector initialized to xbios(2)
'
rez%=XBIOS(4)
IF rez%<>0
  ALERT 3," Please switch   to | low  resolution! ",1,"Oops",b%
  STOP
ENDIF
@get_deskcolors
' my private colours
@vsetall !set the colours
'
robot_type_delay%(0)=30 !frogs
robot_type_delay%(1)=30
robot_type_delay%(2)=30
robot_type_delay%(3)=30
robot_type_delay%(4)=50 !face
robot_type_delay%(5)=50 !brick
robot_type_delay%(6)=0 !balls
robot_type_delay%(7)=0
'
width%=50 ! default width and height of maze
height%=16
window_width%=24 ! number of cells of maze displayed in the window
window_height%=12
celldim%=10 !each cell is 10 pixels across. Don't change it
width_pixels%=window_width%*celldim%-1
height_pixels%=window_height%*celldim%-1
size%=width%*height%-1
xleft%=celldim%
ytop%=celldim%
file_write%=25 !file sequence number for output
file_num%=0 !file sequence number for input
once_only%=0
explorer_dir%=0
CLS
PRINT "get_slid    19 mar 94"
@read_cellpat
@load_help_data
'
@make_puts
CLS
DEFMOUSE 0
' The following parameters control scrolling
' The window scrolls to one of a set of points. *_ctr% define
' the extreme limits of the scrolling in both the vertical and
' horizontal directions.
xleft_ctr%=window_width%/2
ytop_ctr%=window_height%/2
win_height4%=window_height%/4
win_width4%=window_width%/4
xright_ctr%=width%-window_width%/2
ybot_ctr%=height%-window_height%/2
shift_x%=0  !the top left coordinate of maze where scrolling goes to
shift_y%=0
explorer_delay%=0
difficulty%=1
response%=0
simulation_on%=0
'
'
REPEAT
  @select_parameters
UNTIL quit%=1
@restore_deskcolors
IF XBIOS(2)<>screen_ptr%(1)
  ~XBIOS(5,L:-1,L:screen_ptr%(1),-1)
ENDIF
IF XBIOS(3)<>screen_ptr%(1)
  ~XBIOS(5,L:screen_ptr%(1),L:-1,-1)
ENDIF
~FRE(0)
END
'
' The maze is drawn graphically using the functions show_cell and
' show_maze. show_micro_cell and draw_minature_maze are used by the
' editor and help function key.
'
> PROCEDURE show_cell(index%)
  ' displays an individual cell of maze on screen.
  LOCAL ix%,iy%,ixc%,iyc%,num%
  ixc%=(index% MOD width%)
  iyc%=(index% DIV width%)
  ix%=ixc%*celldim%
  iy%=iyc%*celldim%
  IF ix%>319
    ix%=ix%-320
    IF XBIOS(3)<>mazeptr%(1)
      ~XBIOS(5,L:mazeptr%(1),L:-1,-1)
    ENDIF
  ELSE
    IF XBIOS(3)<>mazeptr%(0)
      ~XBIOS(5,L:mazeptr%(0),L:-1,-1)
    ENDIF
  ENDIF
  IF ix%>=0 AND iy%>=0
    SELECT full_maze|(index%)
    CASE 0 TO 3
      PUT ix%,iy%,puts$(full_maze|(index%))
    CASE 4 TO 6
      IF editor_on%=0
        PUT ix%,iy%,puts$(full_maze|(index%)-3)
      ELSE
        PUT ix%,iy%,puts$(full_maze|(index%))
      ENDIF
    CASE 14
      PUT ix%,iy%,exit$
    CASE 15
      PUT ix%,iy%,destin$
    CASE 16 TO 31
      IF teleport_type%(full_maze|(index%)-16)=0
        PUT ix%,iy%,transpo$(0)
      ELSE
        PUT ix%,iy%,transpo$(1)
      ENDIF
    CASE 96 TO 103
      num%=full_maze|(index%)
      num%=num%-96
      PUT ix%,iy%,treasures$(num%)
    CASE 104 TO 111
      num%=full_maze|(index%)
      num%=num%-104
      PUT ix%,iy%,swytches$(num%)
    CASE 128 TO 159
      PUT ix%,iy%,cellpat$(full_maze|(index%)-128)
    CASE 161 TO 170
      PUT ix%,iy%,cell4$(full_maze|(index%)-161)
    CASE 32 TO 95
      num%=full_maze|(index%)
      num%=robot_type%(num%-32)
      PUT ix%,iy%,bugs$(num%)
    CASE 255
      IF editor_on%=1
        PUT ix%,iy%,explorer$(0)
      ENDIF
    DEFAULT
      '        LOCATE 60,22
      '       PRINT index%;" ";full_maze|(index%);
      '        DELAY 0.5
    ENDSELECT
  ENDIF
  IF XBIOS(3)<>screen_ptr%(flip%)
    ~XBIOS(5,L:screen_ptr%(flip%),L:-1,-1)
  ENDIF
RETURN
> PROCEDURE show_micro_cell(index%)
  ' displays an individual cell of maze on screen.
  LOCAL ix%,iy%
  ix%=(index% MOD width%)+1
  iy%=(index% DIV width%)+1
  SELECT full_maze|(index%)
  CASE 0 TO 13
    DEFFILL 0
  CASE 14
    DEFFILL 2
  CASE 16 TO 31
    DEFFILL 2
  CASE 32 TO 95
    DEFFILL 9
  CASE 96 TO 103
    DEFFILL 6
  CASE 104 TO 111
    DEFFILL 8
  CASE 128 TO 254
    DEFFILL 3
  CASE 255
    DEFFILL 15
  DEFAULT
    DEFFILL 1
  ENDSELECT
  PBOX 11+ms%*ix%,11+ms%*iy%,11+ms%-1+ms%*ix%,11+ms%-1+ms%*iy%
RETURN
> PROCEDURE show_maze
  ' displays entire maze withen display window
  LOCAL i%,x%,y%
  editor_on%=0
  IF RANDOM(5)=0
    editor_on%=1
  ENDIF
  FOR y%=0 TO height%-1
    FOR x%=0 TO width%-1
      i%=x%+y%*width%
      show_cell(i%)
    NEXT x%
  NEXT y%
RETURN
> PROCEDURE draw_minature_maze
  LOCAL i%
  COLOR 14
  BOX 10,10,14+width%*ms%,14+height%*ms%
  FOR i%=0 TO size%
    @show_micro_cell(i%)
  NEXT i%
  COLOR 1
RETURN
'
' To allow smooth scrolling in both the horizontal and vertical
' direction we require the following four functions. The scrolling
' attempts to keep the explorer (the car) in the center of the
' screen except when the explorer wanders near the edges of the
' maze. The function nearest_centre computes the position of
' displayed window based on the position of the explorer. First
' the window is displayed by the function slide_window, and
' then the explorer is drawn on top (using a put). The function
' slip_window gives the illusion of smooth motion.
> PROCEDURE nearest_centre(i_explorer%,j_explorer%)
  nearest_x%=i_explorer%
  nearest_y%=j_explorer%
  IF nearest_x%<xleft_ctr%
    nearest_x%=xleft_ctr%
  ENDIF
  IF nearest_x%>xright_ctr%
    nearest_x%=xright_ctr%
  ENDIF
  IF nearest_y%<ytop_ctr%
    nearest_y%=ytop_ctr%
  ENDIF
  IF nearest_y%>ybot_ctr%
    nearest_y%=ybot_ctr%
  ENDIF
  ' screen can only hold 20 squares
  IF nearest_y%>14
    nearest_y%=14
  ENDIF
RETURN
> PROCEDURE slide_window(i_explorer%,j_explorer%)
  ' slides window to new_x% and new_y%
  @nearest_centre(i_explorer%,j_explorer%)
  l_nearest_x%=nearest_x%
  l_nearest_y%=nearest_y%
  shift_x%=(nearest_x%-xleft_ctr%)
  shift_y%=(nearest_y%-ytop_ctr%)
  ixcorner%=shift_x%*celldim%
  iycorner%=shift_y%*celldim%
  i_ex%=(i_explorer%-nearest_x%+xleft_ctr%+1)*celldim%
  j_ex%=(j_explorer%-nearest_y%+ytop_ctr%+1)*celldim%
  @show_window(ixcorner%,iycorner%)
  @put_explorer(i_ex%,j_ex%)
slide_window_return:
RETURN
> PROCEDURE slip_window(i_explorer%,j_explorer%,i_last%,j_last%)
  ' slides window to new_x% and new_y%
  LOCAL delta_x%,delta_y%
  LOCAL incx%
  @nearest_centre(i_explorer%,j_explorer%)
  ixcorner%=(l_nearest_x%-xleft_ctr%)*celldim%
  iycorner%=(l_nearest_y%-ytop_ctr%)*celldim%
  IF nearest_x%<>l_nearest_x%
    delta_x%=(nearest_x%-l_nearest_x%)*celldim%
    inc%=SGN(delta_x%)*2
    i_ex%=(i_explorer%-nearest_x%+xleft_ctr%+1)*celldim%
    j_ex%=(j_explorer%-nearest_y%+ytop_ctr%+1)*celldim%
    REPEAT
      ixcorner%=ixcorner%+inc%
      delta_x%=delta_x%-inc%
      @show_window(ixcorner%,iycorner%)
      @put_explorer(i_ex%,j_ex%)
    UNTIL delta_x%=0
    l_nearest_x%=nearest_x%
  ELSE IF nearest_y%<>l_nearest_y%
    delta_y%=(nearest_y%-l_nearest_y%)*celldim%
    inc%=SGN(delta_y%)*2
    i_ex%=(i_explorer%-nearest_x%+xleft_ctr%+1)*celldim%
    j_ex%=(j_explorer%-nearest_y%+ytop_ctr%+1)*celldim%
    REPEAT
      iycorner%=iycorner%+inc%
      delta_y%=delta_y%-inc%
      @show_window(ixcorner%,iycorner%)
      @put_explorer(i_ex%,j_ex%)
    UNTIL delta_y%=0
    l_nearest_y%=nearest_y%
  ELSE IF i_explorer%<>i_last%
    delta_x%=(i_explorer%-i_last%)*celldim%
    inc%=SGN(delta_x%)*2
    i_ex%=(i_last%-nearest_x%+xleft_ctr%+1)*celldim%
    j_ex%=(j_last%-nearest_y%+ytop_ctr%+1)*celldim%
    ixcorner%=(nearest_x%-xleft_ctr%)*celldim%
    iycorner%=(nearest_y%-ytop_ctr%)*celldim%
    REPEAT
      i_ex%=i_ex%+inc%
      delta_x%=delta_x%-inc%
      @show_window(ixcorner%,iycorner%)
      @put_explorer(i_ex%,j_ex%)
    UNTIL delta_x%=0
  ELSE IF j_explorer%<>j_last%
    delta_y%=(j_explorer%-j_last%)*celldim%
    inc%=SGN(delta_y%)*2
    i_ex%=(i_last%-nearest_x%+xleft_ctr%+1)*celldim%
    j_ex%=(j_last%-nearest_y%+ytop_ctr%+1)*celldim%
    ixcorner%=(nearest_x%-xleft_ctr%)*celldim%
    iycorner%=(nearest_y%-ytop_ctr%)*celldim%
    REPEAT
      j_ex%=j_ex%+inc%
      delta_y%=delta_y%-inc%
      @show_window(ixcorner%,iycorner%)
      @put_explorer(i_ex%,j_ex%)
    UNTIL delta_y%=0
  ELSE
    @show_window(ixcorner%,iycorner%)
    i_ex%=(i_explorer%-nearest_x%+xleft_ctr%+1)*celldim%
    j_ex%=(j_explorer%-nearest_y%+ytop_ctr%+1)*celldim%
    @put_explorer(i_ex%,j_ex%)
  ENDIF
  shift_x%=ixcorner%/celldim%
  shift_y%=iycorner%/celldim%
RETURN
> PROCEDURE show_window(topx%,topy%)
  LOCAL xleft2%
  flip%=1-flip%
  d_mfdb%(0)=screen_ptr%(flip%)
  bltpar%(8)=3
  IF topx%<319-width_pixels%
    s_mfdb%(0)=mazeptr%(0)
    bltpar%(0)=topx%
    bltpar%(1)=topy%
    bltpar%(2)=topx%+width_pixels%
    bltpar%(3)=topy%+height_pixels%
    bltpar%(4)=xleft%
    bltpar%(5)=ytop%
    bltpar%(6)=xleft%+width_pixels%
    bltpar%(7)=ytop%+height_pixels%
    BITBLT s_mfdb%(),d_mfdb%(),bltpar%()
  ELSE IF topx%>319
    topx%=topx%-320
    s_mfdb%(0)=mazeptr%(1)
    bltpar%(0)=topx%
    bltpar%(1)=topy%
    bltpar%(2)=topx%+width_pixels%
    bltpar%(3)=topy%+height_pixels%
    bltpar%(4)=xleft%
    bltpar%(5)=ytop%
    bltpar%(6)=xleft%+width_pixels%
    bltpar%(7)=ytop%+height_pixels%
    BITBLT s_mfdb%(),d_mfdb%(),bltpar%()
  ELSE
    s_mfdb%(0)=mazeptr%(0)
    bltpar%(0)=topx%
    bltpar%(1)=topy%
    bltpar%(2)=319
    bltpar%(3)=topy%+height_pixels%
    bltpar%(4)=xleft%
    bltpar%(5)=ytop%
    bltpar%(6)=xleft%+319-topx%
    bltpar%(7)=ytop%+height_pixels%
    BITBLT s_mfdb%(),d_mfdb%(),bltpar%()
    s_mfdb%(0)=mazeptr%(1)
    bltpar%(0)=0
    bltpar%(1)=topy%
    bltpar%(2)=topx%+width_pixels%-319
    bltpar%(3)=topy%+height_pixels%
    bltpar%(4)=319-topx%+xleft%
    bltpar%(5)=ytop%
    bltpar%(6)=xleft%+width_pixels%
    bltpar%(7)=ytop%+height_pixels%
    BITBLT s_mfdb%(),d_mfdb%(),bltpar%()
  ENDIF
  VSYNC
  IF XBIOS(2)<>screen_ptr%(flip%)
    ~XBIOS(5,L:screen_ptr%(flip%),L:screen_ptr%(flip%),-1)
  ENDIF
RETURN
'
' The game operates by calling the function shift_robots repeatedly
' until an exit condition is set. shift_robots scans all the robots
' and the explorer to see if any are ready to move. It also updates
' master_time and time_shift which ensure that everybody takes their
' turn at the right time. The function shift_robot attempts to move
' the particular robot in the specified direction.
'
'       3            6     7
'    2     0            x          (8 to 11 move like knights in chess)
'       1            5     4
'
' The function move_robot creates the sound effect associated with the
' robot, checks whether the robot is able to move and moves the robot.
' If the robot hits another robot, the other robot may be prodded to
' start moving in the same direction. Some robots (like frog) reverse
' direction when they hit a barrier or change directions (like balls).
'
> PROCEDURE move_robot(i%,last_loc%,next_loc%)
  ' moves robot from last_loc% to next_loc% in full_maze if allowed.
  LOCAL bug_type%,num%,break%,pass_thru%
  '  PRINT i%;"(";robot_status%(i%);") ";
  bug_type%=robot_type%(i%)
  IF bug_type%<5
    @snd_effect(3)
  ELSE IF bug_type%=5
    @snd_effect(9)
  ELSE IF bug_type%=6
    @snd_effect(10)
  ELSE IF bug_type%=7
    @snd_effect(11)
  ELSE IF bug_type%>7
    @snd_effect(12)
  ENDIF
  DEC robot_status%(i%)
  IF (full_maze|(next_loc%)<7)
    full_maze|(last_loc%)=robot_cell%(i%)
    robot_cell%(i%)=full_maze|(next_loc%)
    full_maze|(next_loc%)=i%+32
    @show_cell(last_loc%)
    @show_cell(next_loc%)
    success%=1
    robot_loc%(i%)=next_loc%
    robot_delay%(i%)=robot_type_delay%(bug_type%)
  ELSE IF full_maze|(next_loc%)>31 AND full_maze|(next_loc%)<96 !hit robot
    num%=full_maze|(next_loc%)-32
    bug_type%=robot_type%(num%)
    '    PRINT num%;"(";bug_type%;")  ";
    SELECT bug_type%
    CASE 0,1,2,3 !frog
      robot_status%(num%)=4
    CASE 4 !face
      robot_status%(num%)=1
      robot_dir%(num%)=robot_dir%(i%)
    CASE 6 !red ball
      robot_status%(num%)=10
      robot_dir%(num%)=robot_dir%(i%)
      robot_dir%(i%)=(robot_dir%(i%)+1) MOD 4
      '      PRINT robot_dir%(i%);
    CASE 7 !blue ball
      robot_status%(num%)=10
      robot_dir%(num%)=robot_dir%(i%)
      robot_dir%(i%)=(robot_dir%(i%)+3) MOD 4
      '     PRINT robot_dir%(i%);
    CASE 8
      robot_status%(num%)=2
      robot_dir%(num%)=(robot_dir%(i%) MOD 4)+4
    CASE 9
      robot_status%(num%)=2
      robot_dir%(num%)=((robot_dir%(i%)+2) MOD 4)+4
    CASE 10
      robot_status%(num%)=2
      robot_dir%(num%)=(robot_dir%(i%) MOD 4)+8
    CASE 11
      robot_status%(num%)=2
      robot_dir%(num%)=((robot_dir%(i%)+2) MOD 4)+8
    ENDSELECT
  ELSE IF full_maze|(next_loc%)>95
    robot_status%(i%)=0
  ENDIF
RETURN
> PROCEDURE shift_robot(i%)
  ' shifts robot number i%
  LOCAL last_loc%,next_loc%
  last_loc%=robot_loc%(i%)
  success%=0
  SELECT robot_dir%(i%)
  CASE 0
    IF (last_loc% MOD width%)<width%-1
      next_loc%=last_loc%+1
      @move_robot(i%,last_loc%,next_loc%)
    ENDIF
  CASE 1
    IF last_loc%<size%-width%
      next_loc%=last_loc%+width%
      @move_robot(i%,last_loc%,next_loc%)
    ENDIF
  CASE 2
    IF (last_loc% MOD width%)>0
      next_loc%=last_loc%-1
      @move_robot(i%,last_loc%,next_loc%)
    ENDIF
  CASE 3
    IF last_loc%>width%
      next_loc%=last_loc%-width%
      @move_robot(i%,last_loc%,next_loc%)
    ENDIF
  CASE 4
    next_loc%=last_loc%+width%+1
    IF next_loc%<size%
      @move_robot(i%,last_loc%,next_loc%)
    ENDIF
  CASE 5
    next_loc%=last_loc%+width%-1
    IF next_loc%<size%
      @move_robot(i%,last_loc%,next_loc%)
    ENDIF
  CASE 6
    next_loc%=last_loc%-width%-1
    IF next_loc%>=0
      @move_robot(i%,last_loc%,next_loc%)
    ENDIF
  CASE 7
    next_loc%=last_loc%-width%+1
    IF next_loc%>=0
      @move_robot(i%,last_loc%,next_loc%)
    ENDIF
  CASE 8
    next_loc%=last_loc%+width%+2
    IF next_loc%<size%
      @move_robot(i%,last_loc%,next_loc%)
    ENDIF
  CASE 9
    next_loc%=last_loc%+width%-2
    IF next_loc%<size%
      @move_robot(i%,last_loc%,next_loc%)
    ENDIF
  CASE 10
    next_loc%=last_loc%-width%-2
    IF next_loc%>=0
      @move_robot(i%,last_loc%,next_loc%)
    ENDIF
  CASE 11
    next_loc%=last_loc%-width%+2
    IF next_loc%>=0
      @move_robot(i%,last_loc%,next_loc%)
    ENDIF
  DEFAULT
  ENDSELECT
  IF success%=0 AND robot_type%(i%)<4
    robot_type%(i%)=(robot_type%(i%)+2) MOD 4
    robot_dir%(i%)=robot_type%(i%)
  ENDIF
RETURN
> PROCEDURE shift_robots
  ' shifts all the living robots and checks for motion of
  ' explorer
  LOCAL i%,robot_move%
  robot_move%=0
  time_shift%=TIMER-master_time%
  IF time_shift%>0
    master_time%=TIMER
  ENDIF
  FOR i%=0 TO robot%
    scancode%=@stick_handler
    IF explorer_delay%<=0
      @shift_explorer(scancode%)
    ENDIF
    IF robot_status%(i%)>0 AND robot_delay%(i%)<0
      @shift_robot(i%)
      robot_move%=1
    ELSE
      robot_delay%(i%)=robot_delay%(i%)-time_shift%
    ENDIF
  NEXT i%
  IF robot_move%=1
    @show_window(ixcorner%,iycorner%)
    @put_explorer(i_ex%,j_ex%)
  ENDIF
  explorer_delay%=explorer_delay%-time_shift%
  ' time_shift% is also altered by shift_explorer
RETURN
'
' The function stick_handler returns the motion code from the joystick
' or keyboard. The function shift_explorer, shifts or slides the explorer
' depending on the floor type and adjacent objects. The explorer stops
' when it encounters a barrier or robot, but it may cause the robot
' to start moving. The function shift_explorer also checks for the
' help, undo, esc and F10 keys, takes care of gobbling up the treasures
' and exits the level when the X cell is encountered. Finally, the function
' also takes care of the screen updates.
'
> FUNCTION stick_handler
' The numbers returned by stick_handler correspond to the
' ascii codes of the arrow keys on the keyboard.
LOCAL i%
move%=STICK(1)
SELECT move%
CASE 1
  RETURN 72
CASE 2
  RETURN 80
CASE 4
  RETURN 75
CASE 8
  RETURN 77
DEFAULT
  FOR i%=0 TO 3
    '      IF STRIG(1)=TRUE
    '     RETURN 71
    '  ENDIF
    t$=INKEY$
    IF t$<>""
      scancode%=CVI(t$)
      RETURN scancode%
    ENDIF
  NEXT i%
ENDSELECT
RETURN 0
ENDFUNC
> PROCEDURE shift_explorer(scancode%)
LOCAL i%,j%,next_loc%,teleport_mode%
LOCAL i_last%,j_last%
i%=explorer_loc% MOD width%
j%=explorer_loc% DIV width%
i_last%=i%
j_last%=j%
'  PRINT scancode%;" ";
IF ASC(t$)=27
  exit%=4
ENDIF
SELECT scancode%
CASE 68 !F10
  exit%=3
CASE 72 ! up arrow
  DEC j%
  explorer_dir%=3
CASE 75 !right arrow
  DEC i%
  explorer_dir%=2
CASE 77
  INC i%
  explorer_dir%=0
CASE 80
  INC j%
  explorer_dir%=1
CASE 97 !undo key
  exit%=1
CASE 98 !help key
  ' cheating or debugging
  @draw_minature_maze
  PAUSE 5
  LOCATE 20,1
  PRINT SPACE$(19);
  LOCATE 20,1
  PRINT "hit any key ";
  REPEAT
  UNTIL INKEY$<>""
  LOCATE 20,1
  PRINT SPACE$(19);
  score%=score%-5
  @score_status
DEFAULT
  GOTO shift_exit
ENDSELECT
IF j%>=0 AND j%<height%
  IF i%>=0 AND i%<width%
    next_loc%=j%*width%+i%
    ' slide
    inc_flag%=0
    WHILE (full_maze|(next_loc%)=3 OR full_maze|(next_loc%)=6) AND j%>=0 AND j%<height% AND i%>=0 AND i%<width%
      inc_flag%=1
      IF (explorer_cell%=2 OR explorer_cell%=5) !once only
        explorer_cell%=128+once_only%
        @snd_effect(7)
      ELSE IF (explorer_cell%=1 OR explorer_cell%=4) !twice only
        explorer_cell%=2
        @snd_effect(7)
      ENDIF
      full_maze|(explorer_loc%)=explorer_cell%
      @show_cell(explorer_loc%)
      explorer_cell%=full_maze|(next_loc%)
      full_maze|(next_loc%)=255
      explorer_loc%=next_loc%
      @slide_window(i%,j%)
      i_last%=i%
      j_last%=j%
      SELECT scancode%
      CASE 72 ! up arrow
        DEC j%
      CASE 75 !right arrow
        DEC i%
      CASE 77
        INC i%
      CASE 80
        INC j%
      ENDSELECT
      IF j%>=0 AND j%<height% AND i%>=0 AND i%<width%
        next_loc%=j%*width%+i%
      ENDIF
    WEND
    IF full_maze|(next_loc%)<128
      ' treasures ------------------------
      IF full_maze|(next_loc%)>95 AND full_maze|(next_loc%)<104
        @snd_effect(2)
        gem_type%=full_maze|(next_loc%)-96
        full_maze|(next_loc%)=gem_type%
        @show_cell(next_loc%)
        INC gemfound%
        DEC gemnum%
        @gem_status
        ' hit robot ------------------------
        ' switches
      ELSE IF full_maze|(next_loc%)>31 AND full_maze|(next_loc%)<96
        '          @snd_effect(1)
        robot_num%=full_maze|(next_loc%)-32
        explorer_delay%=60
        SELECT robot_type%(robot_num%)
        CASE 0,1,2,3
          robot_status%(robot_num%)=4
        CASE 4,5
          robot_status%(robot_num%)=1
          robot_dir%(robot_num%)=explorer_dir%
        CASE 6,7
          robot_status%(robot_num%)=10
          robot_dir%(robot_num%)=explorer_dir%
        CASE 8
          robot_status%(robot_num%)=1
          robot_dir%(robot_num%)=explorer_dir%+4
        CASE 9
          robot_status%(robot_num%)=1
          robot_dir%(robot_num%)=((explorer_dir%+2) MOD 4)+4
        CASE 10
          robot_status%(robot_num%)=1
          robot_dir%(robot_num%)=explorer_dir%+8
        CASE 11
          robot_status%(robot_num%)=1
          robot_dir%(robot_num%)=((explorer_dir%+2) MOD 4)+8
        ENDSELECT
        GOTO shift_exit !blocked by robot
      ELSE IF full_maze|(next_loc%)=14
        IF (gemnum%<3)
          exit%=2
          INC file_num%
          IF gemnum%=0
            score%=score%+20
          ELSE
            score%=score%+10
          ENDIF
          IF num_moves%<min_moves% AND gemnum%=0
            score%=score%+30
          ENDIF
        ENDIF
      ENDIF
      ' shift explorer -----------------------
      IF (explorer_cell%=2 OR explorer_cell%=5) !once only
        explorer_cell%=128+once_only%
        @snd_effect(7)
      ELSE IF (explorer_cell%=1 OR explorer_cell%=4) !twice only
        explorer_cell%=2
        @snd_effect(7)
      ENDIF
      full_maze|(explorer_loc%)=explorer_cell%
      INC num_moves%
      @print_life_points
      ' @print_mem
      @show_cell(explorer_loc%)
      explorer_cell%=full_maze|(next_loc%)
      full_maze|(next_loc%)=255
      explorer_loc%=next_loc%
      @slip_window(i%,j%,i_last%,j_last%)
      explorer_delay%=response%
      master_time%=TIMER
      time_shift%=0
    ENDIF
    IF inc_flag%=1
      INC num_moves%
      @print_life_points
    ENDIF
  ENDIF
ENDIF
shift_exit:
RETURN
> PROCEDURE put_explorer(ix%,iy%)
VSYNC
PUT ix%,iy%,explorer_shadow$(explorer_dir%),4
PUT ix%,iy%,explorer$(explorer_dir%),6
RETURN
'
'
> PROCEDURE make_puts
LOCAL i%
nputs%=7
DEFFILL 0,1 !0
PBOX 0,0,13,13
GET 1,1,celldim%,celldim%,puts$(0)
COLOR 2
FOR i%=1 TO 3
  DEFFILL i%+11
  PBOX 0,0,13,13
  GET 1,1,celldim%,celldim%,puts$(i%)
  PLOT 6,6
  GET 1,1,celldim%,celldim%,puts$(i%+3)
NEXT i%
DEFFILL 0
PBOX 0,0,13,13
RETURN
> PROCEDURE make_shadow(VAR a$)
' converts all the non-zero values in a put section to 15's
' to create a mask for writing on the screen using put modes
' 4 and 6. see put_explorer.
LOCAL addr%,wid%,widwrd%,height%,shift%
LOCAL i%
addr%=VARPTR(a$)
wid%=CARD{addr%}
widwrd%=(wid%+16) DIV 16 ! size in 16 bit words
height%=CARD{addr%+2}
size%=widwrd%*8*(height%+1) !4*words*2 = size in bytes
FOR i%=0 TO widwrd%*(height%+1)-1
  shift%=i%*8
  word%=CARD{addr%+6+shift%} ! 8 bytes for every 16 pixel group
  word%=word% OR CARD{addr%+8+shift%}
  word%=word% OR CARD{addr%+10+shift%}
  word%=word% OR CARD{addr%+12+shift%}
  CARD{addr%+6+shift%}=word%
  CARD{addr%+8+shift%}=word%
  CARD{addr%+10+shift%}=word%
  CARD{addr%+12+shift%}=word%
NEXT i%
RETURN
> PROCEDURE write_maze_on_disk
' records problem
LOCAL i%
IF name$=""
  FILESELECT #"Output file","*.dat","getsl"+STR$(file_write%)+".dat",name$
ELSE
  FILESELECT #"Output file","*.dat",name$,name$
ENDIF
OPEN "o",#1,name$
IF name$<>""
  full_maze_init|(explorer_loc_init%)=explorer_cell_init%
  PRINT #1,width%
  PRINT #1,height%
  PRINT #1,explorer_loc_init%
  size%=width%*height%-1
  BPUT #1,VARPTR(full_maze_init|(0)),size%+1
  PRINT #1,robot%
  FOR i%=0 TO robot%-1
    PRINT #1,robot_loc_init%(i%)
  NEXT i%
  FOR i%=0 TO robot%-1
    PRINT #1,robot_type%(i%)
  NEXT i%
  FOR i%=0 TO robot%-1
    PRINT #1,robot_cell_init%(i%)
  NEXT i%
  PRINT #1,once_only%
  PRINT #1,min_moves%
  PRINT #1,n4cells%
  FOR i%=0 TO n4cells%-1
    BPUT #1,VARPTR(cell4$(i%)),326
    '      PRINT #1,cell4$(i%)
  NEXT i%
  CLOSE #1
ENDIF
RETURN
> PROCEDURE read_maze_from_disk(name$)
LOCAL i%
IF EXIST(name$)
  LOCATE 1,1
  PRINT "loading "+name$;
  OPEN "i",#1,name$
  INPUT #1,width%
  INPUT #1,height%
  size%=width%*height%-1
  INPUT #1,explorer_loc_init%
  BGET #1,VARPTR(full_maze_init|(0)),size%+1
  INPUT #1,robot%
  FOR i%=0 TO robot%-1
    INPUT #1,robot_loc_init%(i%)
  NEXT i%
  FOR i%=0 TO robot%-1
    INPUT #1,robot_type%(i%)
  NEXT i%
  FOR i%=0 TO robot%-1
    INPUT #1,robot_cell_init%(i%)
  NEXT i%
  INPUT #1,once_only%
  INPUT #1,min_moves%
  INPUT #1,n4cells%
  FOR i%=0 TO n4cells%-1
    cell4$(i%)=INPUT$(326,#1)
  NEXT i%
  CLOSE #1
  file_ok%=1
  '    LOCATE 1,1
  '    PRINT full_maze_init|(explorer_loc_init%);
  explorer_cell_init%=full_maze_init|(explorer_loc_init%)
  PAUSE 50
ELSE
  TEXT 1,8,name$+" does not exist."
  @total_score
  file_num%=0
  file_ok%=0
  robot%=1
ENDIF
DELAY 1
RETURN
> PROCEDURE restart
LOCAL i%
explorer_loc%=explorer_loc_init%
gemnum%=0
FOR i%=0 TO size%
  full_maze|(i%)=full_maze_init|(i%)
  IF full_maze|(i%)>95 AND full_maze|(i%)<104
    INC gemnum%
  ENDIF
NEXT i%
FOR i%=0 TO robot%-1
  robot_loc%(i%)=robot_loc_init%(i%)
  robot_cell%(i%)=robot_cell_init%(i%)
  robot_status%(i%)=0
  IF robot_type%(i%)<4
    robot_dir%(i%)=robot_type%(i%)
  ENDIF
NEXT i%
xright_ctr%=width%-window_width%/2
ybot_ctr%=height%-window_height%/2
explorer_cell%=full_maze_init|(explorer_loc_init%)
RETURN
> PROCEDURE run_maze
LOCAL i%
CLS
editor_on%=0
flip%=1
ms%=2 !microcell size
exit%=0
score%=0
REPEAT
  name$="GETSL"+STR$(file_num%)+".DAT"
  IF exit%<>1 !don't read maze if UNDO
    @read_maze_from_disk(name$)
  ENDIF
  exit%=0
  @restart
  IF file_ok%=0
    exit%=4
  ENDIF
  life_points%=100
  num_moves%=0
  CLS
  i_explorer%=explorer_loc% MOD width%
  j_explorer%=explorer_loc% DIV width%
  @nearest_centre(i_explorer%,j_explorer%)
  shift_x%=nearest_x%
  shift_y%=nearest_y%
  gemfound%=0
  IF exit%<>3
    @show_maze
    @clear_screen
    @slide_window(i_explorer%,j_explorer%)
    @show_margin
    @print_life_points
    @gem_status
    @level_status
    @score_status
  ENDIF
  master_time%=TIMER
  FOR i%=0 TO robot%-1
    robot_delay%(i%)=0
  NEXT i%
  '
  ' This is the main loop of the program
  robot_status%(robot%)=-1
  REPEAT
    @shift_robots
  UNTIL exit%<>0
  STICK (0)
  IF exit%=3
    INC file_num%
  ENDIF
UNTIL exit%=4
~XBIOS(5,L:screen_ptr%(1),L:screen_ptr%(1),-1)
RETURN
> PROCEDURE show_margin
COLOR 9
BOX celldim%-1,celldim%-1,(window_width%+1)*celldim%,(window_height%+1)*celldim%
DEFLINE 1,3
COLOR 10
BOX celldim%-4,celldim%-3,(window_width%+1)*celldim%+3,(window_height%+1)*celldim%+2
BMOVE screen_ptr%(flip%),screen_ptr%(1-flip%),32000
DEFLINE 1,1
RETURN
'
> PROCEDURE level_status
IF simulation_on%=0
  '  ~XBIOS(5,L:screen_ptr%(flip%),L:-1,-1)
  DEFFILL 0
  DEFTEXT 1
  PBOX 130,150,200,170
  BOX 130,150,200,170
  a$="Level "
  a$=a$+STR$(file_num%)
  TEXT 133,163,a$
  BMOVE screen_ptr%(flip%),screen_ptr%(1-flip%),32000
ENDIF
RETURN
> PROCEDURE score_status
IF simulation_on%=0
  '  ~XBIOS(5,L:screen_ptr%(flip%),L:-1,-1)
  DEFFILL 0
  DEFTEXT 1
  PBOX 230,150,318,170
  BOX 230,150,318,170
  a$="Score "
  a$=a$+STR$(score%)
  TEXT 235,163,a$
  BMOVE screen_ptr%(flip%),screen_ptr%(1-flip%),32000
  ~FRE(0)
ENDIF
RETURN
> PROCEDURE clear_screen
CLS
BMOVE screen_ptr%(flip%),screen_ptr%(1-flip%),32000
RETURN
> PROCEDURE gem_status
IF simulation_on%=0
  '  ~XBIOS(5,L:screen_ptr%(flip%),L:-1,-1)
  DEFFILL 0
  DEFTEXT 1
  a$=""
  IF gemnum%>0
    PBOX 10,175,100,195
    BOX 10,175,100,195
    a$=a$+STR$(gemfound%)
    a$=a$+"/"
    a$=a$+STR$(gemnum%+gemfound%)
    a$=a$+" found"
    TEXT 12,188,a$
  ELSE
    PBOX 10,175,120,195
    BOX 10,175,240,195
    GRAPHMODE 2
    TEXT 14,188,"Go to X to get to next level"
    @snd_effect(8)
  ENDIF
  BMOVE screen_ptr%(flip%),screen_ptr%(1-flip%),32000
  ~FRE(0)
ENDIF
RETURN
> PROCEDURE print_life_points
IF simulation_on%=0
  LOCATE 32,25
  PRINT SPACE$(4);
  LOCATE 32,25
  PRINT num_moves%;"/";min_moves%;
  BMOVE screen_ptr%(flip%),screen_ptr%(1-flip%),32000
  ' hit robot ------------------------
ENDIF
RETURN
> PROCEDURE print_mem
LOCATE 32,1
PRINT SPACE$(4);
LOCATE 32,1
PRINT FRE()
BMOVE screen_ptr%(flip%),screen_ptr%(1-flip%),32000
RETURN
'
> PROCEDURE draw_minature_window
' displays entire maze withen display window
LOCAL i%,x%,y%
FOR y%=shift_y% TO shift_y%+window_height%
  FOR x%=shift_x% TO shift_x%+window_width%
    i%=x%+y%*width%
    show_micro_cell(i%)
  NEXT x%
NEXT y%
RETURN
'
> PROCEDURE read_hex_string(VAR string$)
LOCAL i%,j%,k%,temp$
string$=""
FOR i%=0 TO 86
  j%=MOD(i%,36)+1
  IF j%=1
    READ temp$
  ENDIF
  k%=VAL("&H"+MID$(temp$,j%*2-1,2))
  string$=string$+CHR$(k%)
NEXT i%
RETURN
> PROCEDURE read_cellpat
' the wall textures are read from data statements and put
' into the strings for cellpat$ so that they can be painted
' on the screen using PUT.
LOCAL num%,i%,j%,string$
RESTORE cell_data
numcells%=12
FOR j%=0 TO numcells%-1
  @read_hex_string(string$)
  cellpat$(j%)=string$
NEXT j%
FOR j%=0 TO 3
  @read_hex_string(string$)
  treasures$(j%)=string$
NEXT j%
nbugs%=12
FOR j%=0 TO nbugs%-1
  @read_hex_string(string$)
  bugs$(j%)=string$
NEXT j%
FOR j%=0 TO 3
  @read_hex_string(string$)
  explorer$(j%)=string$
  make_shadow(string$)
  explorer_shadow$(j%)=string$
NEXT j%
@read_hex_string(exit$)
' grass 1 0
cell_data:
' latice 1
DATA 000900090004FFC0F800FFC0FFC0C9C08800C9C0FFC0DDC08800DDC0FFC0FDC0F800FDC0
DATA FFC0DDC00000DDC0FFC0DDC00D80DDC0FFC0DDC00880DDC0FFC0C1C00080C1C0FFC0FFC0
DATA 0F80FFC0FFC0FFC00000FFC0FFC0
' latice 2
DATA 0009000900047FC0FFC001000000A900FFC0BE0088000E40DE00FDC0000084C05F80F8C0
DATA 000088C05FC0E5C000008EC0DFC0E140800042C0DFC0F84000004CC0CEC0F38040001FC0
DATA FFC0C3800000FFC0FE4077800200
' latice 3
DATA 000900090004FCC0CCC03CC00300FCC0CCC03CC00300FC00CC003C0003C0FC00CC003C00
DATA 03C0FFC0CFC03FC00000FFC0CFC03FC00000FFC0C0003FC00000FFC0C0003FC00000FFC0
DATA FFC000000000FFC0FFC000000000
' latice 4
DATA 00090009000407C007C0FFC007C007C007C0FFC007C007C007C0FFC007C007C007C0FFC0
DATA 07C007C007C0FFC007C0F800F800000007C0F800F800000007C0F800F800000007C0F800
DATA F800000007C0F800F800000007C0
' latice 5
DATA 0009000900040000FC00FFC00000C000FE00FFC0C000FC0003C003C00000FE4001C001C0
DATA 0040FF4000C000C00040FE00000001C00000F800F800C7C0C000E000E0001FC00000C000
DATA C0003FC00000C000C0003FC00000
' latice 6
DATA 00090009000430E4CFD200DA00FA9C4EE3CE804E8058EF20F0D2E006E006F788F852F00E
DATA F01239CA3E22F82838061EC61F08FE081E148F1C0FCC7F060F08E78807D41F8E078CE3C6
DATA 83C89FDE83DEF1DEC1DECFDEC1DE
' latice 7
DATA 000900090004002400240024FFD2001A003A000EFFCE3F0E00183F20FFD23F0600062108
DATA FFD23F0E0012210AFFE23F2800062106FFC83F080014211CFFCC3F0600083F08FFD4000E
DATA 000C0006FFC8000800080014FFCA
' latice 8
DATA 0009000900040C24FFE40C24FFD23E1AFBFA3A0EFBCE7E0EE7D86620E7D27E06E3C66208
DATA E3D23F8EE1D2218AE1E21FA8F0C61086F0C81F08F9D4191CF9CC1C06F3C81008F3D4000E
DATA FFCC0006FFC80008FFC80014FFCA
' latice 9
DATA 0009000900040024FFE4FFE40012E01A1E3A1FCE000EE80E1E1817E00012FC061E0603C8
DATA 00127C0EBFD283CA00223DE8FE06C3C600081DC8FE14E3DC000C09C6F608FFC800140BCE
DATA F40CFFC600080E08F1C8FFD4000A
' lattice 10
DATA 0009000900040822000E000E210E0824001C0022370E080E000E0024001CF84600060008
DATA 0012004E0012000A0022006800060006000800480014001C3F0C0046000800082114D84E
DATA 000C00062108080800080014210A
' lattice 11
DATA 000900090004C0003FC00000000060009FC0000000003000CFC0000000001800E7C00000
DATA 000098C0670000000000F1800E400000000073008CC0000000001E00E1C0000000000E00
DATA F1C0000000000300FCC000000000
' lattice 12
DATA 0009000900040C000C000000F3C00C000C000000F3C0330033000000CCC0330033000000
DATA CCC0CCC0CCC000003300CCC0CCC000003300330033000000CCC0330033000000CCC00C00
DATA 0C000000F3C00C000C000000F3C0
' ball1 (treasure)
DATA 00090009000400240024002400120C1A003A120E000E0C0E0018332000120C0600067388
DATA 00127F8E0012000A00227FA80006000600080C080014739C000C0C060008330800140C0E
DATA 000C12060008000800080014000A
' ball2 (treasure)
DATA 00090009000400240024FFE4FFD2121A003AFFCEE1CE330E0018FFE0C0D273860006FFC8
DATA 8052000E0012FFCA806200280006FFC6804873880014FFDC804C33060008FFC8C0D4120E
DATA 000CFFC6E1C800080008FFD4FFCA
' ball3 (treasure)
DATA 0009000900040024FFE4FFE4FFD21E1AE1FAEDCEF3CE3F0EC0D8CCE0F3D27F8680468C48
DATA F3D27F8E8052FFCA80627FA88046FFC680487F8880548C5CF3CC3F06C0C8CCC8F3D41E0E
DATA E1CCEDC6F3C80008FFC8FFD4FFCA
' ball4 (treasure)
DATA 000900090004FFE4FFE40024FFD29EDAFFFA7F0EEDCEBFCEFFD87F20CCD2FFC6FFC67F88
DATA 8C52FFCEFFD27F8AFFE2FFE8FFC67F86FFC8FFC8FFD47F9C8C4CFFC6FFC83F08CCD4FFCE
DATA EFCC0E06FDC8FFC8FFC80014FFCA
' robot 1 frog
DATA 0009000900040000000000000000200020000000000051805180000000000E000E000000
DATA 00000B001E00170002000B001E00170002000E000E000000000051805180000000002000
DATA 2000000000000000000000000000
' robot 2 frog
DATA 00090009000400000000000000002100210000000000408040800000000021002D000C00
DATA 00001E001E000000000012001E000C0000001E001E000C000C002D0021000C0000002100
DATA 2100000000000000000000000000
' robot 3 frog
DATA 0009000900040000000000000000010001000000000062806280000000001C001C000000
DATA 000034001E003A00100034001E003A0010001C001C000000000062806280000000000100
DATA 0100000000000000000000000000
' robot 4 frog
DATA 000900090004000000000000000021002100000000002D0021000C0000001E001E000C00
DATA 0C0012001E000C0000001E001E000000000021002D000C00000040804080000000002100
DATA 2100000000000000000000000000
' robot 5 face
DATA 000900090004FFE4002400240012805A7FBA000E000EB34E4C980020331280466D860008
DATA 1212804E6D92000A12228C68738600060008A1487F94211C210CB3467F88330833149E4E
DATA 7F8C1E061E08FFC800080014000A
' robot 6 brick
DATA 000900090004FFC0FFC0FFC0FFC0FFC0804080408040C0C0BF4080408040C0C0A1409E40
DATA 8040C4C0A1409E408440C4C0A1409E408440C0C0A1409E408040C0C0BF4080408040FFC0
DATA 804080408040FFC0FFC0FFC0FFC0
' robot 7 ball red
DATA 00090009000400000000000000001E001E001E001E003F002100210021007D8042804480
DATA 44807D804280448044807D804280408040807F804080408040803F002100210021001E00
DATA 1E001E001E000000000000000000
' robot 8 ball blue
DATA 00090009000400000000000000001E00000000001E003F001E001E002100718031003100
DATA 4E8079803900390046807D803D003D0042807F803F003F0040803F005E005E0061001E00
DATA 000000001E000000000000000000
' robot 9 bird yellow
DATA 00090009000400000000000000000000000000000000000038000000000010007C001000
DATA 000000007B00040000000000888007000000000008400780000000000780004000000500
DATA 0500050005000500050005000500
' robot 10 bird yellow
DATA 00090009000400000000000000000000000000000000000007000000000002000F800200
DATA 000000003780080000000000444038000000000084007800000000007800800000002800
DATA 2800280028002800280028002800
' robot 11 bird red
DATA 0009000900040022000E000E000E0024001C0022000E600E600E6024601C3006B0067008
DATA B0127C0EFC127C0AFC223F28BF063F06BF081F881F941F9C1F8C0FC60FC80FC80FD40A0E
DATA 000C00060008110800080014000A
' robot 12 bird red
DATA 0009000900040022000E000E000E0024001C0022000E018E018E01A4019C030603460388
DATA 03520F8E0FD20F8A0FE23F283F463F063F487E087E147E1C7E0CFC06FC08FC08FC14140E
DATA 000C00060008220800080014000A
' explorer right
DATA 0009000900040024002400240012001A003A000E000E7E0E7E187E207E1241067F067F08
DATA 7F12C18EFF92FF8AFFA2FFE8FFC6FFC6FFC8FFC8FFD4FFDCFFCC6306000863086314000E
DATA 000C00060008000800080014000A
' explorer down
DATA 0009000900041C241C241C241C123F1A1F3A3F0E3F0E390E1F183F203F1219061F061F08
DATA 1F12190E1F121F0A1F2219281F061F061F0839081F143F1C3F0C3E061E083E083E141C0E
DATA 1C0C1C061C08180818081814180A
' explorer left
DATA 0009000900040024002400240012001A003A000E000E1F8E1F981FA01F9220863F863F88
DATA 3F9260CE7FD27FCA7FE2FFE8FFC6FFC6FFC8FFC8FFD4FFDCFFCC3186000831883194000E
DATA 000C00060008000800080014000A
' explorer up
DATA 00090009000406240624062406120E1A0E3A0E0E0E0E1F0E1E181F201F1227063E063F08
DATA 3F12260E3E123E0A3E2226283E063E063E0826083E143E1C3E0C27063E083F083F143F0E
DATA 3E0C3F063F080E080E080E140E0A
' exit
DATA 0009000900040024002400240012409A40BA408E408E210E211821202112120612061208
DATA 12120C0E0C120C0A0C220C280C060C060C0812081214121C120C2106210821082114408E
DATA 408C40864088000800080014000A
RETURN
'
> PROCEDURE snd_effect(type%)
LOCAL i%,voice%,env%,form%,per%
SELECT type%
CASE 1 !hit robot
  voice%=256*16+1+2+16
  env%=2
  form%=9
  per%=500
  WAVE voice%,env%,form%,per%,2
  FOR i%=0 TO 1200
    SOUND 0,12,#334250+i%
  NEXT i%
  SOUND 0,0
CASE 2 !new gem
  voice%=1
  env%=1
  per%=1000
  SOUND 0,13,1,6,0
  WAVE voice%,env%,9,per%,0
  '    SOUND 0,0
CASE 3 !robot hit explorer
  voice%=1
  env%=1
  per%=30
  SOUND 0,10,1,7
  WAVE voice%,env%,10,per%,0
  SOUND 0,0
CASE 4 !window sliding
  voice%=256*16+1+2+16
  env%=2
  form%=9
  per%=500
  WAVE voice%,env%,form%,per%,1
  SOUND 0,12,#334250+i%
  SOUND 0,0
CASE 5  !expired life
  voice%=256*16+1+2+16
  env%=2
  form%=9
  per%=500
  WAVE voice%,env%,form%,per%,2
  FOR i%=0 TO 150
    PAUSE 1
    SOUND 0,12,#334250+i%*10
  NEXT i%
  SOUND 0,0
CASE 6 ! broken wall
  voice%=256*16+8
  env%=1
  form%=9
  per%=5000
  WAVE voice%,env%,form%,per%,30
  SOUND 0,0
CASE 7 ! woosh - once only
  voice%=256*16+8
  env%=1
  form%=12
  per%=1000
  WAVE voice%,env%,form%,per%,5
  SOUND 0,0
CASE 8
  SOUND 1,12,1,5,10
  SOUND 1,12,3,5,10
  SOUND 1,12,5,5,10
  SOUND 1,12,6,5,20
  SOUND 1,0
CASE 9! switch
  voice%=256*16+1+2+16
  env%=2
  form%=9
  per%=5000
  WAVE voice%,env%,form%,per%,1
  SOUND 0,12,#334250
  SOUND 0,0
CASE 10 ! red ball moving
  voice%=1
  env%=1
  per%=5000
  SOUND 0,13,1,6,0
  WAVE voice%,env%,9,per%,0
CASE 11 ! red ball moving
  voice%=1
  env%=1
  per%=5000
  SOUND 0,13,1,7,0
  WAVE voice%,env%,9,per%,0
CASE 12
  FOR i%=0 TO 3
    SOUND 0,12,#50+i%*5,1
  NEXT i%
  SOUND 0,0
ENDSELECT
RETURN
'
> PROCEDURE get_deskcolors
LOCAL i%
FOR i%=0 TO 15
  deskcolors%(i%)=XBIOS(7,i%,-1)
NEXT i%
RETURN
> PROCEDURE restore_deskcolors
LOCAL i%
FOR i%=0 TO 15
  SETCOLOR i%,deskcolors%(i%)
NEXT i%
RETURN
> PROCEDURE read_colorluts
LOCAL i%
RESTORE luts
FOR i%=0 TO 15
  READ luts&(i%)
  tabcolor%(i%)=i%
NEXT i%
' note documentation error in GFA manual. Composite order is
' BGR instead of RGB
luts:
DATA &H000,&H00c,&H08e,&H0ce,&H0ee,&H0ea,&H0e0,&H0a6
DATA &Ha80,&He00,&Ha06,&H008,&H080,&H800,&H066,&Heee
RETURN
> PROCEDURE vsetall
@read_colorluts
LOCAL i%
FOR i%=0 TO 15
  VSETCOLOR i%,luts&(tabcolor%(i%))
NEXT i%
RETURN
'
> PROCEDURE title_border
LOCAL i%,j%
titleput0%=RANDOM(12)
titleput1%=RANDOM(12)
FOR i%=0 TO 28
  FOR j%=0 TO 18
    IF j%<3 OR j%>14 OR i%<4 OR i%>24
      IF MOD(i%+j%,2)=0
        PUT celldim%*i%,celldim%*j%,cellpat$(titleput0%)
      ELSE
        PUT celldim%*i%,celldim%*j%,cellpat$(titleput1%)
      ENDIF
    ENDIF
  NEXT j%
NEXT i%
RETURN
> PROCEDURE show_parameter(num%)
' show the current parameter in the top menu .
LOCAL xtxt%
xtxt%=90
GRAPHMODE 1
DEFFILL 0,1
SELECT num%
CASE 1
  TEXT xtxt%,(num%+4)*10,"Instructions"
CASE 3
  TEXT xtxt%+20,(num%+4)*10,"Level"
  PBOX xtxt%+65,(num%+3)*10+2,120+xtxt%,(num%+5)*10
  TEXT xtxt%+65,(num%+4)*10,STR$(file_num%)
CASE 5
  TEXT xtxt%+30,(num%+4)*10,"Start"
CASE 7
  TEXT xtxt%+30,(num%+4)*10,"Quit"
ENDSELECT
RETURN
> PROCEDURE show_all_parameters
' display the menu with all its parameters.
LOCAL i%,x1%,y1%,r%
DEFTEXT 4,0,0,6
DEFFILL 0,1
PRBOX 0,0,319,199
@title_border
FOR i%=1 TO 7
  @show_parameter(i%)
NEXT i%
TEXT 55,135,"Please turn volume up."
RETURN
> PROCEDURE select_parameters
' select and modify parameter using mouse.
LOCAL choice%,highlight%,key$
DEFFILL 0
' select character height
DEFTEXT 1,0,0,6
' clear screen
PBOX 0,0,319,199
highlight%=0
@show_all_parameters
SETMOUSE 10,185,0
REPEAT
  key$=""
  REPEAT
    key$=INKEY$
    SHOWM
    choice%=(MOUSEY-10)/10-2
    ' highlight if mouse moved to a new parameter
    IF highlight%<>choice%
      DEFTEXT 4,0
      show_parameter(highlight%)
      DEFTEXT 2,0
      show_parameter(choice%)
      highlight%=choice%
    ENDIF
    IF MOUSEK=0
      tim%=TIMER
    ENDIF
  UNTIL MOUSEK<>0 OR key$<>""
  ' left mouse button increases parameter value, right button decreases
  IF MOUSEK=1
    modify_parameter(choice%,1)
  ENDIF
  IF MOUSEK=2
    modify_parameter(choice%,-1)
  ENDIF
  IF choice%<>6
    show_parameter(choice%)
  ENDIF
  PAUSE 10
  IF key$="r"
    LOCATE 1,24
    PRINT titleput0%;" ";titleput1%;
  ENDIF
UNTIL choice%=8 OR choice%=7
DEFTEXT 1,0
RETURN
> PROCEDURE modify_parameter(num%,dir%)
' raise or lower selected parameter withen limits.
'  LOCATE 1,1
'  PRINT num%;
SELECT num%
CASE 1
  @instructions
CASE 3
  file_num%=file_num%+dir%
  IF file_num%<0
    file_num%=0
  ENDIF
CASE 5
  @run_maze
  @show_all_parameters
CASE 7
  quit%=1
ENDSELECT
RETURN
> PROCEDURE instructions
CLS
PRINT "Collect the Gems  31-8-93"
PRINT
PRINT "Using the the joystick or"
PRINT "arrow keys, collect  the"
PRINT "gems in the maze and go to exit"
PRINT "before you run out of moves."
PRINT
PRINT "The Undo button restarts the current"
PRINT "maze. The Esc button quits the game."
PRINT "F10 goes on to the next level."
PRINT
PRINT "...Click mouse button to continue."
PAUSE 30
REPEAT
UNTIL MOUSEK<>0
CLS
PRINT
PRINT
PRINT "Programmed by Seymour Shlien"
PRINT "        624 Courtenay Avenue"
PRINT "       Ottawa, Canada K2A 3B5"
PRINT
PRINT "The program and the sources are public"
PRINT "domain."
PRINT
PRINT
PRINT "...Click mouse button to continue."
PAUSE 30
REPEAT
UNTIL MOUSEK<>0
CLS
@show_all_parameters
RETURN
> PROCEDURE load_help_data
LOCAL i%
RESTORE help_data
FOR i%=1 TO 7
  READ help$(i%)
NEXT i%
help_data:
DATA "How to play this game."
DATA "Level of difficulty."
DATA "Select starting maze."
DATA "Control joystick response."
DATA
DATA "Ready to go."
DATA "Exit to desktop."
RETURN
'
> PROCEDURE dosound
LOCAL i%
'  SPOKE &H484,PEEK(&H484) AND NOT 1
IF number_of_xbs_files%>0
  addr%=V:music_data&(0)
  ~XBIOS(32,L:addr%)
ENDIF
RETURN
> PROCEDURE read_sound
LOCAL a%,i%
IF EXIST("getslide.xbs") AND FRE(0)>100000
  OPEN "i",#1,"getslide.xbs"
  a%=LOF(#1)
  DIM music_data&(a%/2)
  BLOAD "getslide.xbs",VARPTR(music_data&(0))
  CLOSE #1
  number_of_xbs_files%=1
ELSE
  number_of_xbs_files%=0
ENDIF
RETURN
> PROCEDURE total_score
DEFFILL 3
PBOX 60,40,280,80
TEXT 70,50,"Your total score is "+STR$(score%)
TEXT 70,70,"Click mouse ..."
@dosound
STICK (0)
REPEAT
UNTIL MOUSEK<>0
RETURN