{
***************************************************************************
*                                                                         *
* FRINGDUS - The Game. (1/12/92)                                          *
*                                                                         *
*  By Jason Nunn (JsNO BAR----NUNN)                                       *
*                                                                         *
* Email: nunn@pandanus.cs.ntu.edu.au                                      *
*                                                                         *
* This game is freeware                                                   *
*                                                                         *
* Description: A game. At this stage, it writes blocks of graphics to the *
*              video memory which is determined by fring1.map             *
*                                                                         *
***************************************************************************
}
program fringdus;

uses
  memory, crt;

const
  norm_vid  = 3;
  hires_vid = 19;
  video_mem = 40960;
  buff_size = 60000;


  map_min_x = 0;
  map_max_x = 99;
  map_min_y = 0;
  map_max_y = 99;

  view_min_y = 0;
  view_max_y = 4;
  view_min_x = 0;
  view_max_x = 6;

  nullchar               = #0;
  enter                  = #13;
  back_space             = #8;
  bell                   = #7;
  uparrow                = #0#72;
  leftarrow              = #0#75;
  rightarrow             = #0#77;
  downarrow              = #0#80;
  esc                    = #27;
  space                  = ' ';
  page_up                = #0'I';
  page_down              = #0'Q';
  home                   = #0'G';
  eend                   = #0'O';


type
  map_attrib = array[map_min_x..map_max_x,map_min_y..map_max_y] of byte;
  map_file_attrib = file of map_attrib;

var
  ch           : string[2];
  pic_file     : file;
  pic_buff     : ^byte;
  map          : map_attrib;
  map_file     : map_file_attrib;
  num_read     : word;
  x_pos        : real;
  y_pos        : real;
  x_inc        : real;
  y_inc        : real;

{
***************************************************************************
*                                                                         *
***************************************************************************
}
procedure init;
var
  x        : byte;
  y        : byte;
  credit   : string[80];
begin
  x_pos := 135;
  y_pos := 225;
  x_inc := 0;
  y_inc := 0;
  credit := ' FRINGDUS:- By Jason Nunn (nunn@pandanus.cs.ntu.edu.au, JsNO BAR----NUNN)';
end;

{
***************************************************************************
*                                                                         *
* Utility functions                                                       *
*                                                                         *
*                                                                         *
* If you don't know assembly, just download a 286/86 instruction matrix   *
* from the Net (eg archie.au), there should be one on there. That's how   *
* I learnt it.                                                            *
*                                                                         *
***************************************************************************
}
procedure videooff; assembler;
asm
  mov  al,norm_vid  {default mode}
  mov  ah,0
  int  16 {video services}
end;


procedure videoon; assembler;
asm
  mov  al,hires_vid {320*200   256 colours}
  mov  ah,0
  int  16  {video services}
end;

{Writes a byte of a given value (colour) to the screen. This function
is needed to paint the base screen}

procedure write_byte(color : byte; pos : word); assembler;
asm
     mov   bx,video_mem
     mov   es,bx

     mov   bx,pos
     mov   al,color
     mov   es:[bx],al
end;


{clears the screen}

procedure clr(color : byte); assembler;
asm
     mov   bx,video_mem
     mov   es,bx
     mov   al,color
     mov   di, 0
     mov   cx,64000

     cld   {go up the scale, eg DI := DI + 1}
     rep   stosb {byte string paster}
end;



{
DISCUSSION: The routines: move_bloc, move_part_left_bloc &
move_part_right_bloc, do the job of actually copying the sprites to the
screen. You will notice there is three functions!. This is because
each has to special type of function.

Inorder to get it the paint in one big square, these functions have to chop
off/ignore certain bytes so that they don't leak off into the "no-paint"
zone.

Now, chopping off the top and bottom is easy. All it has to do is NOT
copy bytes if less than 9600 (offset) or greater than 56000 (offset) bytes-
not alot of overhead here. BUT left and right is a bit more complex. Therefore
It would be quicker if we had "move_part_left_bloc" handle all the left most
sprites that have to be chopped and "move_part_right_bloc" to handle all
the right most sprites and "move_bloc" handles the rest. It saves O/H,
because we are not applying complex "leakage-detection" to sprites that
are nowhere near the border. Secondly, because of the nature of the
algo's, "move_part_left_bloc" & "move_part_right_bloc" can only do byte
copying. "mov_bloc" how ever does word copying, hence it is faster than
"move_part_left_bloc" & "move_part_right_bloc" routines. This is why I
like customisation.
}

procedure move_bloc(var ptrr; xmm, ymm : word; bloc_loc : word); assembler;
asm
     push  ds
     mov   dl,255
     mov   bx,video_mem
     mov   es,bx
     mov   dl,0
     push  dx

     lds   di,ptrr  {load ds, hence, DS is set where our sprites are in memory}
     mov   ax,900
     mov   cx,bloc_loc
     mul   cx
     mov   bx,ax

     mov   ax,320
     mov   cx,ymm
     mul   cx
     add   ax,xmm
     pop   dx

@@write_row:
     mov   si,bx

     mov   di,ax
     cmp   ax,9600
     jb    @@not_print
     cmp   ax,56000
     ja    @@not_print

     mov   cx,15
     cld
     rep   movsw  {Note the word copying here, the other routines}
@@not_print:      {only have byte copying}
     add   ax,320
     inc   dl
     add   bx,30
     cmp   dl,30
     jne   @@write_row
     pop  ds
end;


{basically, "move_part_left_bloc" first calulates how much is "hanging out
the side". It then only copied those bytes that are within the border (>50),
also SI is ajusted to ONLY copy whats needed}


procedure move_part_left_bloc(var ptrr; xmm, ymm : word; bloc_loc : word); assembler;
var
  store_print  : word;
asm
     mov   store_print,30
     push  ds
     mov   dl,255
     mov   bx,video_mem
     mov   es,bx
     mov   dl,0
     push  dx

     lds   di,ptrr
     mov   ax,900
     mov   cx,bloc_loc
     mul   cx
     mov   bx,ax
     cmp   xmm,50
     jb    @@adjust
@@adjust_back:

     mov   ax,320
     mov   cx,ymm
     mul   cx
     add   ax,xmm
     pop   dx

@@write_row:
     mov   si,bx

     mov   di,ax

     cmp   ax,9600
     jb    @@not_print
     cmp   ax,56000
     ja    @@not_print

     mov   cx,store_print {only copy's if x >= 50}
     cld
     rep   movsb
@@not_print:

     add   ax,320
     inc   dl
     add   bx,30
     cmp   dl,30
     jne   @@write_row
     pop  ds
     jmp  @@end
@@adjust:
     mov   ax,50
     sub   ax,xmm              {Here's the adjustment}
     sub   store_print,ax
     add   bx,ax
     mov   xmm,50
     jmp @@adjust_back
@@end:
end;

{does the same thing, accept for the right side. It just won't copy
anything where xmm > 260}

procedure move_part_right_bloc(var ptrr; xmm, ymm : word; bloc_loc : word); assembler;
var
  write_store : word;
asm
     push  ds
     mov   dl,255
     mov   bx,video_mem
     mov   es,bx
     mov   dl,0
     push  dx

     lds   di,ptrr
     mov   ax,900
     mov   cx,bloc_loc
     mul   cx
     mov   bx,ax

     mov   ax,320
     mov   cx,ymm
     mul   cx
     add   ax,xmm

     mov   dx,260  {and here is where it gets adjusted}
     sub   dx,xmm  { <----}
     mov   write_store,dx

     pop   dx

@@write_row:
     mov   si,bx

     mov   di,ax
     cmp   ax,9600
     jb    @@not_print
     cmp   ax,56000
     ja    @@not_print


     mov   cx,write_store   {see here, it cuts off the copying}
     cld
     rep   movsb
@@not_print:

     add   ax,320
     inc   dl
     add   bx,30
     cmp   dl,30
     jne   @@write_row
     pop  ds
end;

{
***************************************************************************
*                                                                         *
* Paints a BMP windows format to the video memory. I don't no the format, *
* I worked it out by first print a raw image. If any one knows it, please *
* send me a copy of the format.                                           *
*                                                                         *
***************************************************************************
}
procedure base_screen;
var
  base_pic  : file;
  pic_buff  : array[0..2048] of byte;
  paint     : word;
  numread   : word;
  lap_count : word;
  wx        : integer;
  wy        : integer;
begin
  assign(base_pic, 'b_scr.bmp');
  reset(base_pic, 1);
  blockread(base_pic, pic_buff, 1078, numread);
  wx := 0;
  wy := 199;
  lap_count := 0;
  repeat
    blockread(base_pic, pic_buff, 2048, numread);
    for paint := 0 to numread do
    begin
      if lap_count <> 2048 then
      begin
        write_byte(pic_buff[paint], wx + (wy * 320));
        wx := wx + 1;

        if wx > 319 then
        begin
          write_byte(0, wx + (wy * 320));
          wx := 0;
          wy := wy - 1;
        end;
        lap_count := lap_count + 1;
      end
      else
      begin
        lap_count := 0;
      end;
    end;
  until eof(base_pic);
  close(base_pic);
end;

{
***************************************************************************
*                                                                         *
*  This code determines what to read in the map.file (now in memory), what*
* sprites need to be printed, and their positions any need to be printed. *
*                                                                         *
***************************************************************************
}
procedure plot_screen(bloc_x, bloc_y : integer);
var
  start_block_x   : word;
  start_block_y   : word;
  block_ofs_x     : word;
  block_ofs_y     : word;
  cxx             : byte;
  cy              : byte;

begin
  start_block_x := bloc_x div 30;  {works out the scrolling offsetf64}
  block_ofs_x := bloc_x mod 30;
  start_block_y := bloc_y div 30;
  block_ofs_y := bloc_y mod 30;

  for cy := view_min_y to (view_max_y + 1) do
  begin
    for cxx := view_min_x to (view_max_x + 1) do
    begin
      if (block_ofs_x <> 0) and (cxx = view_min_x) then
      begin
        move_part_left_bloc(pic_buff^,
                  50 + cxx * 30 - block_ofs_x,   {the "block_ofs_x: is the main action}
                  30 + cy * 30 - block_ofs_y,    {part of the scrolling process,} 
                  map[start_block_x + cxx, start_block_y + cy]); {that goes for "block_ofs_y" as well}
      end
      else if (block_ofs_x <> 0) and (cxx = (view_max_x + 1)) then
      begin
        move_part_right_bloc(pic_buff^,
                  50 + cxx * 30 - block_ofs_x,
                  30 + cy * 30 - block_ofs_y,
                  map[start_block_x + cxx, start_block_y + cy]);
      end
      else if (cxx < (view_max_x + 1)) then
      begin                                                   {Pretty simple really :) - not alot to it}
        move_bloc(pic_buff^,
                  50 + cxx * 30 - block_ofs_x,
                  30 + cy * 30 - block_ofs_y,
                  map[start_block_x + cxx, start_block_y + cy]);
      end
    end;
  end;
end;

{
***************************************************************************
*                                                                         *
***************************************************************************
}
begin
  init;
  videoon;
  base_screen;
  assign(pic_file, 'fringpc1.pic');
  reset(pic_file, 1);
  pic_buff := memalloc(buff_size); {Pascal is starting to get celver now,}
                                   {look!- a memory allocation module}

  blockread(pic_file, pic_buff^, filesize(pic_file), num_read);
  close(pic_file);

  assign(map_file, 'fring1.map');
  reset(map_file);
  read(map_file, map);
  close(map_file);
  repeat
    plot_screen(trunc(x_pos), trunc(y_pos));

    if keypressed then
    begin
      ch := readkey;
      if ch = #0 then ch := ch + readkey;
    end
    else
    begin
      ch := #1;
    end;

    if ch = downarrow then
      y_inc := y_inc + 0.5
    else if ch = uparrow then
      y_inc := y_inc + -0.5        {keys adjust marginal dX & dY}
    else if ch = leftarrow then
      x_inc := x_inc + -0.5
    else if ch = rightarrow then
      x_inc := x_inc + 0.5
    else if ch = home then
    begin
      y_inc := y_inc + -0.5;  {dX changes X etc}
      x_inc := x_inc + -0.5;
    end
    else if ch = page_up then
    begin
      y_inc := y_inc + -0.5; {dY changes Y}
      x_inc := x_inc + 0.5;
    end
    else if ch = eend then
    begin
      y_inc := y_inc + 0.5;
      x_inc := x_inc - 0.5;
    end
    else if ch = page_down then
    begin
      y_inc := y_inc + 0.5;
      x_inc := x_inc + 0.5;
    end;

    x_pos := x_pos + x_inc;
    y_pos := y_pos + y_inc;


    if x_pos < map_min_x then
    begin
      x_inc := x_inc * -1;  {boundary setting for X}
      x_pos := 0;
    end;
    if x_pos > ((map_max_x * 30) - (view_max_x * 30)) then
    begin
      x_pos := ((map_max_x * 30) - (view_max_x * 30));
      x_inc := x_inc * -1;
    end;
    if y_pos < map_min_y then  {boundary setting for y}
    begin
      y_pos := 0;
      y_inc := y_inc * -1;
    end;
    if y_pos > ((map_max_y * 30) - (view_max_y * 30)) then
    begin
      y_pos := ((map_max_y * 30) - (view_max_y * 30));
      y_inc := y_inc * -1;
    end;

  until ch = #27;
  freemem(pic_buff, buff_size);
  videooff;
  textcolor(7);
  textbackground(0);
  writeln;   {logo.......hey ya!, hey ya!, hey ya!}
  writeln('FringDus - By Jason Nunn - (C) 1992 - This Game is Freeware');
  writeln;
  writeln('Know where to connect me?');
  writeln('Email: nunn@pandanus.cs.ntu.edu.au    or');
  writeln('Snail: 8 Winton Street,');
  writeln('       Jingili, Darwin,');
  writeln('       Northern Territory,');
  writeln('       Australia, PO 0850');
  writeln;
end.