Upload

FOREST/AOS1.PAS

@@ -0,0 +1,7 @@
+unit aos1;
+{$L pos1.obj}
+interface
+procedure posi1;far;
+implementation
+procedure posi1;external;
+end.

FOREST/AOS2.PAS

@@ -0,0 +1,7 @@
+unit aos2;
+{$L pos2.obj}
+interface
+procedure posi2;far;
+implementation
+procedure posi2;external;
+end.

FOREST/AOS3.PAS

@@ -0,0 +1,7 @@
+unit aos3;
+{$L pos3.obj}
+interface
+procedure posi3;far;
+implementation
+procedure posi3;external;
+end.

FOREST/BGR.PAS

@@ -0,0 +1,7 @@
+unit bgr;
+{$L hillback.obj}
+interface
+procedure hback;far;
+implementation
+procedure hback;external;
+end.

FOREST/DP

@@ -0,0 +1,4 @@
+
+ Volume in drive H is DOS_UTILS      Serial number is 1AA1:BA79
+           0 bytes in 0 file(s)
+  51,433,472 bytes free

FOREST/DP2

@@ -0,0 +1,4 @@
+
+ Volume in drive H is DOS_UTILS      Serial number is 1AA1:BA79
+           0 bytes in 0 file(s)
+  51,435,520 bytes free

FOREST/KOE.PAS

@@ -0,0 +1,46 @@
+uses crt;
+var   f      : file;
+      buf    : array[0..30000] of byte;
+      font   : array[0..237*31] of byte;
+      x      : word;
+begin
+    asm
+    mov   ax,$13
+    int   $10
+    end;
+
+    assign(f,'pos1.dat');
+    reset(f,1);
+    blockread(f,buf,filesize(f));
+    close(f);
+
+    fillchar(font,sizeof(font),#0);
+    for x := 0 to 30 do font[x*237+20] := 15;
+    for x := 0 to 30 do font[x*237+21] := 15;
+
+    asm
+    mov   ax,$a000
+    mov   es,ax
+    mov   si,offset buf
+
+    mov   bx,offset font
+
+    mov   dx,237*31
+@a: lodsw
+    or    ax,ax
+    je    @no
+    mov   cx,ax
+@b: lodsw
+    mov   di,ax
+    mov   al,byte ptr ds:[bx]
+    mov   byte ptr es:[di],al
+    loop  @b
+@no:
+    inc   bx
+    dec   dx
+    jnz   @a
+    end;
+
+
+    repeat until keypressed;
+end.

FOREST/MAKEOB.BAT

@@ -0,0 +1 @@
+binobj hillback.clx hillback hback

FOREST/READ.PAS

@@ -0,0 +1,218 @@
+uses crt,aos1,aos2,aos3,bgr;
+
+const  veke = 2800;
+
+procedure setrgb(c,r,g,b:byte);
+begin
+     port[$3c8] := c;
+     port[$3c9] := r;
+     port[$3c9] := g;
+     port[$3c9] := b;
+end;
+
+var  frames : word;
+      w     : word;
+
+
+procedure waitr;
+begin
+        asm
+	mov	bx,1
+	int	0fch
+        mov     frames,ax
+        end;
+end;
+
+
+function dis_exit:boolean;
+var   a : byte;
+begin
+        asm
+	mov	bx,2
+	int	0fch
+        mov     a,al
+        end;
+        if a = 0 then dis_exit := false else dis_exit := true;
+end;
+
+var   f : file;
+      inx : word;
+      y,x,t   : word;
+      pal    : array[0..768] of byte;
+      font   : array[0..320*31] of byte;
+      fpal,tmppal : array[0..768] of byte;
+      scp,sss:word;
+
+{$L routines.obj}
+          { dx = Bground seg,
+            ax = pos seg,
+            si = pos ofs,
+            cx = font seg,
+            bx = font ofs }
+
+procedure putrouts;far;external;
+
+procedure scr(pos:byte);
+begin
+  case pos of
+
+   0:asm
+      mov   dx,seg hback
+      mov   ax,seg posi1
+      mov   si,offset posi1
+      mov   cx,seg font
+      mov   bx,offset font
+      add   bx,scp
+      call  putrouts
+     end;
+   1:asm
+      mov   dx,seg hback
+      mov   ax,seg posi2
+      mov   si,offset posi2
+      mov   cx,seg font
+      mov   bx,offset font
+      add   bx,scp
+      call  putrouts
+     end;
+   2:asm
+      mov   dx,seg hback
+      mov   ax,seg posi3
+      mov   si,offset posi3
+      mov   cx,seg font
+      mov   bx,offset font
+      add   bx,scp
+      call  putrouts
+      inc   scp
+     end;
+  end;
+end;
+
+
+var   frame : word;
+      quit  : word;
+      ch    : char;
+      perse : boolean;
+      fadeout : boolean;
+      fp      : byte;
+begin
+     asm
+     mov   ax,$13
+     int   $10
+
+     xor   bx,bx
+     int   0fch
+
+     end;
+
+     assign(f,'o.sci');
+     reset(f,1);
+     for x := 0 to 30 do
+      begin
+       seek(f,x*320+778);
+       blockread(f,font[x*237],237);
+      end;
+     close(f);
+
+     for x := 0 to sizeof(font) do if font[x] > 0 then inc(font[x],128);
+     move(mem[seg(hback):ofs(hback)+10],pal,768);
+     move(mem[seg(hback):ofs(hback)+778], mem[seg(hback):ofs(hback)], 64000);
+     for x := 0 to 255 do setrgb(x,0,0,0);
+     move(mem[seg(hback):ofs(hback)],mem[$a000:0],64000);
+
+     move(pal,tmppal,768);
+     fillchar(tmppal,32*3,#0);
+     fillchar(tmppal[128*3],32*3,#0);
+     fillchar(fpal,768,#0);
+
+     w := 1;     { Wait raster routine }
+
+     for y := 0 to 63 do
+      begin
+        waitr;
+        for x := 0 to 255 do setrgb(x,fpal[x*3+0],fpal[x*3+1],fpal[x*3+2]);
+        for x := 0 to 255 do
+         begin
+          if fpal[x*3+0] < tmppal[x*3+0] then inc(fpal[x*3+0]);
+          if fpal[x*3+1] < tmppal[x*3+1] then inc(fpal[x*3+1]);
+          if fpal[x*3+2] < tmppal[x*3+2] then inc(fpal[x*3+2]);
+         end;
+      end;
+
+     move(pal,tmppal,768);
+     move(pal,fpal,768);
+     fillchar(fpal,32*3,#0);
+     fillchar(fpal[128*3],32*3,#0);
+     for x := 0 to 255 do setrgb(x,fpal[x*3+0],fpal[x*3+1],fpal[x*3+2]);
+
+     asm
+@a:  mov   ax,0
+     mov   bx,6
+     int   0fch
+     cmp   dx,0
+     jl    @a
+     end;
+
+     for y := 0 to 150 do waitr;
+
+     sss := 0;
+     scp := 0;
+
+     for y := 0 to 63*2 do
+      begin
+        waitr;
+        scr(sss);
+        if sss = 2 then sss := 0 else inc(sss);
+
+        if y and 1 = 1 then
+        begin
+        for x := 0 to 176 do setrgb(x,fpal[x*3+0],fpal[x*3+1],fpal[x*3+2]);
+        for x := 0 to 176 do
+         begin
+          if fpal[x*3+0] < tmppal[x*3+0] then inc(fpal[x*3+0]);
+          if fpal[x*3+1] < tmppal[x*3+1] then inc(fpal[x*3+1]);
+          if fpal[x*3+2] < tmppal[x*3+2] then inc(fpal[x*3+2]);
+         end;
+        end;
+      end;
+
+    fillchar(tmppal,768,#0);
+
+
+    { Loppu looppi }
+
+    frame := 0;
+    w     := 0;
+    ch    := #0;
+    quit  := 0;
+    repeat
+     waitr;
+     scr(sss);
+     if sss = 2 then sss := 0 else inc(sss);
+
+{     inc(frame);}
+
+     asm
+     mov   ax,0
+     mov   bx,6
+     int   0fch
+     cmp   dx,-11
+     jnz   @a
+     mov   fadeout,1
+@a:  end;
+
+
+
+      if fadeout then
+        begin
+        if fp = 64 then quit := 1 else inc(fp);
+        for x := 0 to 255 do
+         begin
+          setrgb(x,fpal[x*3+0],fpal[x*3+1],fpal[x*3+2]);
+          if fpal[x*3+0] > tmppal[x*3+0] then dec(fpal[x*3+0]);
+          if fpal[x*3+1] > tmppal[x*3+1] then dec(fpal[x*3+1]);
+          if fpal[x*3+2] > tmppal[x*3+2] then dec(fpal[x*3+2]);
+         end;
+        end;
+
+     until dis_exit or (frame = veke) or (quit = 1);
+end.

FOREST/READ2.PAS

@@ -0,0 +1,225 @@
+uses crt,aos1,aos2,aos3,bgr;
+
+const  veke = 2800;
+
+procedure setrgb(c,r,g,b:byte);
+begin
+     port[$3c8] := c;
+     port[$3c9] := r;
+     port[$3c9] := g;
+     port[$3c9] := b;
+end;
+
+var  frames : word;
+      w     : word;
+
+
+procedure waitr;
+begin
+        asm
+	mov	bx,1
+	int	0fch
+        mov     frames,ax
+        end;
+end;
+
+
+function dis_exit:boolean;
+var   a : byte;
+begin
+        asm
+	mov	bx,2
+	int	0fch
+        mov     a,al
+        end;
+        if a = 0 then dis_exit := false else dis_exit := true;
+end;
+
+var   f : file;
+      inx : word;
+      y,x,t   : word;
+      pal    : array[0..768] of byte;
+      fbuf   : array[0..640*31] of byte;
+      font   : array[0..237*31] of byte;
+      fpal,tmppal : array[0..768] of byte;
+      scp,sss:word;
+
+{$L routines.obj}
+          { dx = Bground seg,
+            ax = pos seg,
+            si = pos ofs,
+            cx = font seg,
+            bx = font ofs }
+
+procedure putrouts;far;external;
+
+procedure scr(pos:byte);
+var ff : word;
+begin
+  case pos of
+
+   0:asm
+      mov   dx,seg hback
+      mov   ax,seg posi1
+      mov   si,offset posi1
+      mov   cx,seg font
+      mov   bx,offset font
+      call  putrouts
+     end;
+   1:asm
+      mov   dx,seg hback
+      mov   ax,seg posi2
+      mov   si,offset posi2
+      mov   cx,seg font
+      mov   bx,offset font
+      call  putrouts
+     end;
+   2:begin
+      asm
+       mov   dx,seg hback
+       mov   ax,seg posi3
+       mov   si,offset posi3
+       mov   cx,seg font
+       mov   bx,offset font
+       call  putrouts
+      end;
+      move(font[1],font[0],237*31);
+      for ff := 0 to 30 do font[ff*237+236] := fbuf[ff*640+scp];
+      if scp < 639 then inc(scp);
+     end;
+  end;
+end;
+
+
+var   frame : word;
+      quit  : word;
+      ch    : char;
+      perse : boolean;
+      fadeout : boolean;
+      fp      : byte;
+begin
+     asm
+     mov   ax,$13
+     int   $10
+
+     xor   bx,bx
+     int   0fch
+
+     end;
+
+     assign(f,'o2.sci');
+     reset(f,1);
+     for x := 0 to 30 do
+      begin
+       seek(f,x*640+778);
+       blockread(f,fbuf[x*640],640);
+      end;
+     close(f);
+
+     for x := 0 to sizeof(fbuf) do if fbuf[x] > 0 then inc(fbuf[x],128);
+     move(mem[seg(hback):ofs(hback)+10],pal,768);
+     move(mem[seg(hback):ofs(hback)+778], mem[seg(hback):ofs(hback)], 64000);
+     for x := 0 to 255 do setrgb(x,0,0,0);
+     move(mem[seg(hback):ofs(hback)],mem[$a000:0],64000);
+
+     move(pal,tmppal,768);
+     fillchar(tmppal,32*3,#0);
+     fillchar(tmppal[128*3],32*3,#0);
+     fillchar(fpal,768,#0);
+
+     w := 1;     { Wait raster routine }
+
+     for y := 0 to 63 do
+      begin
+        waitr;
+        for x := 0 to 255 do setrgb(x,fpal[x*3+0],fpal[x*3+1],fpal[x*3+2]);
+        for x := 0 to 255 do
+         begin
+          if fpal[x*3+0] < tmppal[x*3+0] then inc(fpal[x*3+0]);
+          if fpal[x*3+1] < tmppal[x*3+1] then inc(fpal[x*3+1]);
+          if fpal[x*3+2] < tmppal[x*3+2] then inc(fpal[x*3+2]);
+         end;
+      end;
+
+     move(pal,tmppal,768);
+     move(pal,fpal,768);
+     fillchar(fpal,32*3,#0);
+     fillchar(fpal[128*3],32*3,#0);
+     for x := 0 to 255 do setrgb(x,fpal[x*3+0],fpal[x*3+1],fpal[x*3+2]);
+
+     for x := 0 to 30 do move(fbuf[x*640],font[x*237+104],133);
+     scp := 133;
+
+     asm
+@a:  mov   ax,0
+     mov   bx,6
+     int   0fch
+     cmp   dx,0
+     jl    @a
+     end;
+
+{     for y := 0 to 150 do waitr;}
+
+     sss := 0;
+
+     for y := 0 to 63*2 do
+      begin
+        waitr;
+
+        if y and 1 = 1 then
+        begin
+        for x := 0 to 176 do setrgb(x,fpal[x*3+0],fpal[x*3+1],fpal[x*3+2]);
+        for x := 0 to 176 do
+         begin
+          if fpal[x*3+0] < tmppal[x*3+0] then inc(fpal[x*3+0]);
+          if fpal[x*3+1] < tmppal[x*3+1] then inc(fpal[x*3+1]);
+          if fpal[x*3+2] < tmppal[x*3+2] then inc(fpal[x*3+2]);
+         end;
+        end;
+
+        scr(sss);
+        if sss = 2 then sss := 0 else inc(sss);
+      end;
+
+    fillchar(tmppal,768,#0);
+
+
+    { Loppu looppi }
+
+    frame := 0;
+    w     := 0;
+    ch    := #0;
+    quit  := 0;
+    repeat
+     waitr;
+
+     asm
+     mov   ax,0
+     mov   bx,6
+     int   0fch
+     cmp   dx,-11
+     jnz   @a
+     mov   fadeout,1
+@a:  end;
+
+      if fadeout then
+        begin
+        if fp = 64 then quit := 1 else inc(fp);
+        for x := 0 to 255 do
+         begin
+          setrgb(x,fpal[x*3+0],fpal[x*3+1],fpal[x*3+2]);
+          if fpal[x*3+0] > tmppal[x*3+0] then dec(fpal[x*3+0]);
+          if fpal[x*3+1] > tmppal[x*3+1] then dec(fpal[x*3+1]);
+          if fpal[x*3+2] > tmppal[x*3+2] then dec(fpal[x*3+2]);
+         end;
+        end;
+
+
+     scr(sss);
+     if sss = 2 then sss := 0 else inc(sss);
+
+{     inc(frame);}
+
+
+     until dis_exit or (frame = veke) or (quit = 1);
+end.

FOREST/READMASK.PAS

@@ -0,0 +1,193 @@
+uses crt;
+
+type    pbuf = ^buf;
+        buf = array[0..64000] of byte;
+
+
+var    r,r1,
+       g,b  : pbuf;
+       f      : file;
+       x,y,c  : word;
+       row    : array[0..320*3-1] of byte;
+       tc     : word;
+       tbuf   : array[0..100] of word;
+       pal    : array[0..768] of byte;
+
+procedure setrgb(c,r,g,b:byte);
+begin
+     port[$3c8] := c;
+     port[$3c9] := r;
+     port[$3c9] := g;
+     port[$3c9] := b;
+end;
+
+begin
+     getmem(r,64000);
+     getmem(r1,64000);
+     getmem(g,64000);
+     getmem(b,64000);
+     fillchar(r^,64000,#0);
+     fillchar(r1^,64000,#0);
+     fillchar(g^,64000,#0);
+     fillchar(b^,64000,#0);
+
+     { Load fixed green mask }
+     assign(f,'green.clx');
+     reset(f,1);
+     seek(f,778);
+     blockread(f,g^,64000);
+     close(f);
+
+     asm
+     mov   ax,$13
+     int   $10
+     end;
+{
+     assign(f,'hillback.clx');
+     reset(f,1);
+     seek(f,10);
+     blockread(f,pal,768);
+     for x := 0 to 255 do setrgb(x,pal[x*3+0],pal[x*3+1],pal[x*3+2]);
+     blockread(f,mem[$a000:0],64000);
+     close(f);
+}
+
+     assign(f,'o:mask1.mtv');
+     reset(f,1);
+     seek(f,8);
+     for y := 0 to 199 do
+     begin
+      blockread(f,row,320*3);
+      for x := 0 to 319 do
+       begin
+        r^[x+y*320] := row[x*3+0];
+        b^[x+y*320] := row[x*3+2];
+       end;
+     end;
+     close(f);
+     assign(f,'o:mask2.mtv');
+     reset(f,1);
+     seek(f,8);
+     for y := 0 to 199 do
+     begin
+      blockread(f,row,320*3);
+      for x := 0 to 319 do r1^[x+y*320] := row[x*3+0];
+     end;
+     close(f);
+     assign(f,'pos1.dat');
+     rewrite(f,1);
+     { red = 4 to 240 }
+     for y := 1 to 31 do
+     for c := 4 to 240 do
+     begin
+       tc := 0;
+       for x := 0 to 64000 do
+         if (mem[$a000:x] <> 40) and (r^[x] <> r1^[x]) and (r^[x] = c) and (g^[x] = y) and (b^[x] = 255) then
+         begin
+           tbuf[tc] := x;
+           mem[$a000:x] := 40;
+           inc(tc);
+         end;
+       blockwrite(f,tc,2);
+       if tc > 0 then blockwrite(f,tbuf,tc*2);
+     end;
+     close(f);
+
+
+     assign(f,'o:mask2.mtv');
+     reset(f,1);
+     seek(f,8);
+     for y := 0 to 199 do
+     begin
+      blockread(f,row,320*3);
+      for x := 0 to 319 do
+       begin
+        r^[x+y*320] := row[x*3+0];
+        b^[x+y*320] := row[x*3+2];
+       end;
+     end;
+     close(f);
+     assign(f,'o:mask3.mtv');
+     reset(f,1);
+     seek(f,8);
+     for y := 0 to 199 do
+     begin
+      blockread(f,row,320*3);
+      for x := 0 to 319 do r1^[x+y*320] := row[x*3+0];
+     end;
+     close(f);
+     assign(f,'pos2.dat');
+     rewrite(f,1);
+     { red = 4 to 240 }
+     for y := 1 to 31 do
+     for c := 4 to 240 do
+     begin
+       tc := 0;
+       for x := 0 to 64000 do
+         if (mem[$a000:x] <> 40) and (r^[x] <> r1^[x]) and (r^[x] = c) and (g^[x] = y) and (b^[x] = 255) then
+         begin
+           tbuf[tc] := x;
+           mem[$a000:x] := 40;
+           inc(tc);
+         end;
+       blockwrite(f,tc,2);
+       if tc > 0 then blockwrite(f,tbuf,tc*2);
+     end;
+     close(f);
+
+
+     assign(f,'o:mask3.mtv');
+     reset(f,1);
+     seek(f,8);
+     for y := 0 to 199 do
+     begin
+      blockread(f,row,320*3);
+      for x := 0 to 319 do
+       begin
+        r^[x+y*320] := row[x*3+0];
+        b^[x+y*320] := row[x*3+2];
+       end;
+     end;
+     close(f);
+     assign(f,'o:mask4.mtv');
+     reset(f,1);
+     seek(f,8);
+     for y := 0 to 199 do
+     begin
+      blockread(f,row,320*3);
+      for x := 0 to 319 do r1^[x+y*320] := row[x*3+0];
+     end;
+     close(f);
+     assign(f,'pos3.dat');
+     rewrite(f,1);
+     { red = 4 to 240 }
+     for y := 1 to 31 do
+     for c := 4 to 240 do
+     begin
+       tc := 0;
+       for x := 0 to 64000 do
+         if (mem[$a000:x] <> 40) and (r^[x] <> r1^[x]) and (r^[x] = c) and (g^[x] = y) and (b^[x] = 255) then
+         begin
+           tbuf[tc] := x;
+           mem[$a000:x] := 40;
+           inc(tc);
+         end;
+       blockwrite(f,tc,2);
+       if tc > 0 then blockwrite(f,tbuf,tc*2);
+     end;
+     close(f);
+
+
+
+     repeat until keypressed;
+
+     asm
+     mov   ax,$3
+     int   $10
+     end;
+
+     freemem(r,64000);
+     freemem(r1,64000);
+     freemem(g,64000);
+     freemem(b,64000);
+end.

FOREST/READMSK2.PAS

@@ -0,0 +1,138 @@
+uses crt;
+
+type    pbuf = ^buf;
+        buf = array[0..64000] of byte;
+
+
+var    r,r1,nb,g,b  : pbuf;
+       f      : file;
+       x,y,c  : word;
+       row    : array[0..320*3-1] of byte;
+       tw     : word;
+       tb     : word;
+       tbuf   : array[0..100] of word;
+       pal    : array[0..768] of byte;
+
+procedure setrgb(c,r,g,b:byte);
+begin
+     port[$3c8] := c;
+     port[$3c9] := r;
+     port[$3c9] := g;
+     port[$3c9] := b;
+end;
+
+procedure tee(n1,n2,n3:string);
+begin
+     assign(f,n1);
+     reset(f,1);
+     seek(f,8);
+     for y := 0 to 199 do
+     begin
+      blockread(f,row,320*3);
+      for x := 0 to 319 do
+       begin
+        r^[x+y*320] := row[x*3+0];
+        b^[x+y*320] := row[x*3+2];
+       end;
+     end;
+     close(f);
+     assign(f,n2);
+     reset(f,1);
+     seek(f,8);
+     for y := 0 to 199 do
+     begin
+      blockread(f,row,320*3);
+      for x := 0 to 319 do r1^[x+y*320] := row[x*3+0];
+     end;
+     close(f);
+     assign(f,n3);
+     rewrite(f,1);
+     for y := 1 to 31 do
+     for c := 4 to 240 do
+     begin
+       tw := 0;
+       for x := 0 to 64000 do
+         if (nb^[x] <> $40) and
+            (r^[x] <> r1^[x]) and
+            (r^[x] = c) and
+            (r^[x+1] = c) and
+            (g^[x] = y) and
+            (b^[x] = 255) then
+         begin
+           tbuf[tw] := x;
+           nb^[x] := $40;
+           nb^[x+1] := $40;
+           memw[$a000:x] := $4040;
+           inc(tw);
+         end;
+       blockwrite(f,tw,2);
+       if tw > 0 then blockwrite(f,tbuf,tw*2);
+
+       tb := 0;
+       for x := 0 to 64000 do
+         if (nb^[x] <> $40) and
+            (r^[x] <> r1^[x]) and
+            (r^[x] = c) and
+            (g^[x] = y) and
+            (b^[x] = 255) then
+         begin
+           tbuf[tb] := x;
+           nb^[x] := $40;
+           mem[$a000:x] := $40;
+           inc(tb);
+         end;
+       blockwrite(f,tb,2);
+       if tb > 0 then blockwrite(f,tbuf,tb*2);
+     end;
+     close(f);
+end;
+
+begin
+     getmem(r,64000);
+     getmem(r1,64000);
+     getmem(g,64000);
+     getmem(b,64000);
+     getmem(nb,64000);
+     fillchar(r^,64000,#0);
+     fillchar(r1^,64000,#0);
+     fillchar(g^,64000,#0);
+     fillchar(b^,64000,#0);
+     fillchar(nb^,64000,#0);
+
+     { Load fixed green mask }
+     assign(f,'green.clx');
+     reset(f,1);
+     seek(f,778);
+     blockread(f,g^,64000);
+     close(f);
+
+     asm
+     mov   ax,$13
+     int   $10
+     end;
+{
+     assign(f,'hillback.clx');
+     reset(f,1);
+     seek(f,10);
+     blockread(f,pal,768);
+     for x := 0 to 255 do setrgb(x,pal[x*3+0],pal[x*3+1],pal[x*3+2]);
+     blockread(f,mem[$a000:0],64000);
+     close(f);
+}
+     tee('o:mask1.mtv','o:mask2.mtv','pos1.dat');
+     tee('o:mask2.mtv','o:mask3.mtv','pos2.dat');
+     tee('o:mask3.mtv','o:mask4.mtv','pos3.dat');
+
+     asm
+     mov   ax,$3
+     int   $10
+     end;
+
+     writeln('Homma on valmis !!!!!!!!!!!!!!!');
+
+     freemem(r,64000);
+     freemem(r1,64000);
+     freemem(g,64000);
+     freemem(b,64000);
+     freemem(nb,64000);
+end.

FOREST/ROUTINES.ASM

@@ -0,0 +1,40 @@
+          .MODEL  large,PASCAL
+          .CODE
+          .386
+
+          ; dx = Bground seg
+          ;  ax = pos seg
+          ;  si = pos ofs
+          ;  cx = font seg
+          ;  bx = font ofs
+
+Putrouts  PROC FAR
+          PUBLIC Putrouts
+
+          push   ds
+          mov    ds,ax
+          mov    ax,0a000h
+          mov    es,ax
+          mov    fs,cx
+          mov    gs,dx
+
+          mov    dx,237*31
+@a:       lodsw                        ; get byte count
+          or     ax,ax                 ; if 0 then hidden pixel
+          je     @ei                   ; next pixel
+          mov    cx,ax                 ; set loop value
+@c:       lodsw                        ; get destination address
+          mov    di,ax
+          mov    al,byte ptr gs:[di]   ; get bground pixel
+          add    al,byte ptr fs:[bx]   ; add font value to pixel
+          mov    byte ptr es:[di],al   ; store pixel to screen
+          loop   @c
+@ei:
+          inc    bx
+          dec    dx
+          jnz    @a
+          pop    ds
+
+          ret
+Putrouts  ENDP
+          END

FOREST/X.BAT

@@ -0,0 +1,2 @@
+copy read2.exe ..\main\data\mntscrl.exe
+copy o2.sci ..\main\data