home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / CAVE.ZIP / THEGRAPH.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-02  |  17KB  |  670 lines
  1. UNIT thegraph;
  2.  
  3. INTERFACE
  4.  
  5. USES pcx,crt;
  6.  
  7. CONST    ROM_CHAR_SET_SEG=$F000;
  8.          ROM_CHAR_SET_OFF=$FA6E;
  9.          VGA_INPUT_STATUS_1=$3DA;
  10.          VGA_VSYNC_MASK=$08;
  11.          VGA256=$13;
  12.          TEXT_MODE=$03;
  13.          PALETTE_MASK=$3c6;
  14.          PALETTE_REGISTER_RD=$3c7;
  15.          PALETTE_REGISTER_WR=$3c8;
  16.          PALETTE_DATA=$3c9;
  17.          SCREEN_WIDTH=320;
  18.          SCREEN_HEIGHT=200;
  19.          CHAR_WIDTH=8;
  20.          CHAR_HEIGHT=8;
  21.          SPRITE_WIDTH=64;
  22.          SPRITE_HEIGHT=64;
  23.          MAX_SPRITE_FRAMES=24;
  24.          SPRITE_DEAD=0;
  25.          SPRITE_ALIVE=1;
  26.          SPRITE_DYING=2;
  27.  
  28. TYPE RGB_color_typ=RECORD
  29.         red:byte;
  30.         green:byte;
  31.         blue:byte;
  32.        END;
  33.  
  34.      worm_typ=RECORD
  35.         y,color,speed,counter:INTEGER;
  36.       END;
  37.  
  38.       sprite_typ=RECORD
  39.         x,y:integer;
  40.         x_old,y_old:integer;
  41.         width,height:integer;
  42.         anim_clock:integer;
  43.         anim_speed:integer;
  44.         motion_speed:integer;
  45.         motion_clock:integer;
  46.         frames:array[1..MAX_SPRITE_FRAMES] OF pcximage;
  47.         cur_frame:integer;
  48.         num_frames:integer;
  49.         state:integer;
  50.         background:pcximage;
  51.        END;
  52.  
  53. VAR double_buffer:pcximage;
  54.  
  55. PROCEDURE Blit_Char(xc,yc:INTEGER; c:CHAR; color:byte; trans_flag:BOOLEAN);
  56. PROCEDURE Blit_String(x,y,color:INTEGER; word:string; trans_flag:boolean);
  57. PROCEDURE Set_Palette_Register(index:integer; color:RGB_color_typ);
  58. PROCEDURE Get_Palette_Register(index:integer; color:RGB_color_typ);
  59. PROCEDURE Plot_Pixel_Fast(x,y:integer; color:byte);
  60. PROCEDURE Plot_Pixel_Fast_D(x,y:integer; color:byte);
  61. FUNCTION Get_Pixel(x,y:integer):byte;
  62. FUNCTION Get_Pixel_D(x,y:INTEGER):byte;
  63. PROCEDURE Show_Double_Buffer_h;
  64. procedure show_double_buffer_a;
  65. PROCEDURE Init_Double_Buffer;
  66. PROCEDURE Sprite_Init(VAR sprite:sprite_typ; x,y,ac,as,mc,ms,w,h:INTEGER);
  67. PROCEDURE Sprite_Delete(VAR sprite:sprite_typ);
  68. PROCEDURE Get_sprite_coord(image:pcximage;
  69.                           VAR sprite:sprite_typ;
  70.                           sprite_frame:integer;
  71.                           grab_x,grab_y:integer);
  72. PROCEDURE Get_sprite(image:pcximage;
  73.                           VAR sprite:sprite_typ;
  74.                           sprite_frame:integer;
  75.                           grab_x,grab_y:integer);
  76. PROCEDURE Behind_Sprite(VAR sprite:sprite_typ);
  77. PROCEDURE Erase_Sprite(VAR sprite:sprite_typ);
  78. PROCEDURE Draw_Sprite(VAR sprite:sprite_typ);
  79. PROCEDURE Behind_Sprite_VB(VAR sprite:sprite_typ);
  80. PROCEDURE Erase_Sprite_VB(VAR sprite:sprite_typ);
  81. PROCEDURE Draw_Sprite_VB(VAR sprite:sprite_typ);
  82. PROCEDURE Melt;
  83. FUNCTION raw_char(code:INTEGER):char;
  84. PROCEDURE do_box(x1,y1,x2,y2,color:INTEGER);
  85. PROCEDURE Draw_Sprite_F(VAR sprite:sprite_typ);
  86. PROCEDURE Draw_sprite_VBF(VAR sprite:sprite_typ);
  87. PROCEDURE Blit_String_D(x,y,color:INTEGER; word:string);
  88. PROCEDURE Blit_Char_D(xc,yc:INTEGER; c:char; color:INTEGER);
  89. PROCEDURE cls;
  90.  
  91. IMPLEMENTATION
  92. (*------------------ Procedure Blit_Char _D -----------------------------*)
  93.  
  94. PROCEDURE cls;
  95. BEGIN
  96. ASM
  97.  mov bx,0a000h
  98.  mov es,bx
  99.  mov di,0
  100.  mov cx,320/2*200
  101.  mov ax,0
  102.  rep stosw
  103. END;
  104. END;
  105.  
  106. PROCEDURE Blit_Char_D(xc,yc:INTEGER; c:char; color:INTEGER);
  107.  
  108. VAR offset,x,y,doff,dseg:INTEGER;
  109.     work_char:byte;
  110.     bit_mask:byte;
  111.  
  112. BEGIN
  113. doff:=ofs(double_buffer^);
  114. dseg:=seg(double_buffer^);
  115. work_char:=mem[$f000:$fa6e+ (ord(c) * char_height-1)];
  116. offset := (yc SHL 8) + (yc SHL 6) + xc;
  117. for y:=0 to CHAR_HEIGHT-1 DO
  118. BEGIN
  119.   bit_mask:=$80;
  120.   if (y=(CHAR_HEIGHT/2)) THEN color:=color-8;
  121.   for x:=0 to CHAR_WIDTH-1 DO
  122.   BEGIN
  123.     if (work_char AND bit_mask)<>0 THEN
  124.     mem[dseg:doff+offset+x]:=color;
  125.     bit_mask:=(bit_mask SHR 1);
  126.   END;
  127.   offset := offset + SCREEN_WIDTH;
  128.   work_char:=mem[$f000:$fa6e+ (ord(c) * char_height)+y];
  129. END;
  130. END;
  131.  
  132.  
  133. (*------------------ Procedure Blit_String_D ------------------------------*)
  134.  
  135.  
  136. PROCEDURE Blit_String_D(x,y,color:INTEGER; word:string);
  137.  
  138. VAR index:integer;
  139.  
  140. BEGIN
  141.   FOR index:=1 TO length(word) DO
  142.   BEGIN
  143.     Blit_Char_D(x+(index SHL 3),y,word[index],color);
  144.   END;
  145. END;
  146. PROCEDURE do_box(x1,y1,x2,y2,color:INTEGER);
  147.  
  148. VAR row,column:integer;
  149.  
  150. BEGIN
  151.   FOR row:=y1 TO y2 DO
  152.   FOR column:=x1 TO x2 DO
  153.     mem[$a000:(row SHL 8) + (row SHL 6) + column]:=color;
  154. END;
  155.  
  156. FUNCTION raw_char(code:INTEGER):char;
  157. BEGIN
  158.  CASE code OF
  159.   30:raw_char:='a';
  160.   48:raw_char:='b';
  161.   46:raw_char:='c';
  162.   32:raw_char:='d';
  163.   18:raw_char:='e';
  164.   33:raw_char:='f';
  165.   34:raw_char:='g';
  166.   35:raw_char:='h';
  167.   23:raw_char:='i';
  168.   36:raw_char:='j';
  169.   37:raw_char:='k';
  170.   38:raw_char:='l';
  171.   50:raw_char:='m';
  172.   49:raw_char:='n';
  173.   24:raw_char:='o';
  174.   25:raw_char:='p';
  175.   16:raw_char:='q';
  176.   19:raw_char:='r';
  177.   31:raw_char:='s';
  178.   20:raw_char:='t';
  179.   22:raw_char:='u';
  180.   47:raw_char:='v';
  181.   17:raw_char:='w';
  182.   45:raw_char:='x';
  183.   21:raw_char:='y';
  184.   44:raw_char:='z';
  185.   ELSE raw_char:='0';
  186.  END;
  187. END;
  188.  
  189. PROCEDURE Blit_Char(xc,yc:INTEGER; c:CHAR; color:byte; trans_flag:BOOLEAN);
  190.  
  191. VAR offset,x,y:INTEGER;
  192.     work_char:byte;
  193.     bit_mask:byte;
  194.  
  195. BEGIN
  196. work_char:=mem[$f000:$fa6e+ (ord(c) * char_height-1)];
  197. offset := (yc SHL 8) + (yc SHL 6) + xc;
  198. for y:=0 to CHAR_HEIGHT-1 DO
  199. BEGIN
  200.   bit_mask:=$80;
  201.   for x:=0 to CHAR_WIDTH-1 DO
  202.   BEGIN
  203.     if (work_char AND bit_mask)<>0 THEN
  204.     mem[$a000:offset+x]:=color
  205.     ELSE IF (NOT trans_flag) THEN
  206.           mem[$a000:offset+x]:=0;
  207.     bit_mask:=(bit_mask SHR 1);
  208.   END;
  209.   offset := offset + SCREEN_WIDTH;
  210.   work_char:=mem[$f000:$fa6e+ (ord(c) * char_height)+y];
  211. END;
  212. END;
  213.  
  214. PROCEDURE Blit_String(x,y,color:INTEGER; word:string; trans_flag:boolean);
  215.  
  216. VAR index:integer;
  217.  
  218. BEGIN
  219.   FOR index:=1 TO length(word) DO
  220.   BEGIN
  221.     Blit_Char(x+(index SHL 3),y,word[index],color,trans_flag);
  222.   END;
  223. END;
  224.  
  225.  
  226. PROCEDURE Set_Palette_Register(index:integer; color:RGB_color_typ);
  227. BEGIN
  228.   port[PALETTE_MASK]:=$ff;
  229.  port[PALETTE_REGISTER_WR]:=index;
  230.   port[PALETTE_DATA]:=color.red;
  231.   port[PALETTE_DATA]:=color.green;
  232.   port[PALETTE_DATA]:=color.blue;
  233. END;
  234.  
  235. PROCEDURE Get_Palette_Register(index:integer; color:RGB_color_typ);
  236. BEGIN
  237.   port[PALETTE_MASK]:=$ff;
  238.   port[PALETTE_REGISTER_RD]:=index;
  239.   color.red   := port[PALETTE_DATA];
  240.   color.green := port[PALETTE_DATA];
  241.   color.blue  := port[PALETTE_DATA];
  242. END;
  243.  
  244.  
  245. PROCEDURE Plot_Pixel_Fast(x,y:integer; color:byte);
  246. BEGIN
  247.    mem[$a000:((y SHL 8) + (y SHL 6)) + x]:= color;
  248. END;
  249.  
  250. PROCEDURE Plot_Pixel_Fast_D(x,y:integer; color:byte);
  251. BEGIN
  252.   mem[seg(double_buffer^):
  253.       ofs(double_buffer^)+((y SHL 8) + (y SHL 6)) + x] := color;
  254. END;
  255.  
  256. FUNCTION Get_Pixel(x,y:integer):byte;
  257. BEGIN
  258.   get_pixel:=mem[$A000:((y SHL 8) + (y SHL 6)) + x];
  259. END;
  260.  
  261. FUNCTION Get_Pixel_D(x,y:INTEGER):byte;
  262. BEGIN
  263.   get_pixel_d:= mem[seg(double_buffer^):
  264.                     ofs(double_buffer^)+((y SHL 8) + (y SHL 6)) + x]
  265. END;
  266.  
  267. PROCEDURE Wait_For_Vsync;
  268. BEGIN
  269. {while(port[VGA_INPUT_STATUS_1] AND VGA_VSYNC_MASK=0) DO;}
  270. while(port[VGA_INPUT_STATUS_1] AND VGA_VSYNC_MASK=1) DO;
  271. END;
  272.  
  273.  
  274. PROCEDURE Melt;
  275.  
  276. VAR index,ticks:integer;
  277.     worms:ARRAY[1..320] of worm_typ;
  278.  
  279. BEGIN
  280.   ticks:=0;
  281. for index:=1 TO 160 DO
  282. BEGIN
  283.   worms[index].color   := Get_Pixel(index,0);
  284.   worms[index].speed   := 3 + random(9)+1;
  285.   worms[index].y       := 0;
  286.   worms[index].counter := 0;
  287.   Plot_Pixel_Fast((index SHL 1),0,worms[index].color);
  288.   Plot_Pixel_Fast((index SHL 1),1,worms[index].color);
  289.   Plot_Pixel_Fast((index SHL 1),2,worms[index].color);
  290.   Plot_Pixel_Fast((index SHL 1)+1,0,worms[index].color);
  291.   Plot_Pixel_Fast((index SHL 1)+1,1,worms[index].color);
  292.   Plot_Pixel_Fast((index SHL 1)+1,2,worms[index].color);
  293. END;
  294.  
  295. while ticks<1800 DO
  296. BEGIN
  297.   for index:=1 TO 320 DO
  298.   BEGIN
  299.     INC(worms[index].counter);
  300.     if (worms[index].counter = worms[index].speed) THEN
  301.     BEGIN
  302.       worms[index].counter := 0;
  303.       worms[index].color := Get_Pixel(index,worms[index].y+4);
  304.       if (worms[index].y < 194) THEN
  305.       BEGIN
  306.         Plot_Pixel_Fast((index SHL 1),worms[index].y,0);
  307.         Plot_Pixel_Fast((index SHL 1),worms[index].y+1,worms[index].color);
  308.         Plot_Pixel_Fast((index SHL 1),worms[index].y+2,worms[index].color);
  309.         Plot_Pixel_Fast((index SHL 1),worms[index].y+3,worms[index].color);
  310.         Plot_Pixel_Fast((index SHL 1)+1,worms[index].y,0);
  311.         Plot_Pixel_Fast((index SHL 1)+1,worms[index].y+1,worms[index].color);
  312.         Plot_Pixel_Fast((index SHL 1)+1,worms[index].y+2,worms[index].color);
  313.         Plot_Pixel_Fast((index SHL 1)+1,worms[index].y+3,worms[index].color);
  314.         INC(worms[index].y);
  315.        END;
  316.     END;
  317.   END;
  318.   if ticks MOD 500=0 THEN
  319.   BEGIN
  320.     for  index:=1 TO 160 DO
  321.             DEC(worms[index].speed);
  322.   END;
  323.     Wait_For_Vsync;
  324.     ticks:=ticks+1;
  325.   END;
  326. END;
  327.  
  328. PROCEDURE Show_Double_Buffer_h;
  329. BEGIN
  330.   move(mem[seg(double_buffer^):ofs(double_buffer^)],mem[$a000:$0000],320*152);
  331. END;
  332. PROCEDURE Show_Double_Buffer_a;
  333. BEGIN
  334.   move(mem[seg(double_buffer^):ofs(double_buffer^)],mem[$a000:$0000],320*200);
  335. END;
  336. PROCEDURE Init_Double_Buffer;
  337. BEGIN
  338.   check_mem(double_buffer,screen_width*screen_height)
  339. END;
  340.  
  341. PROCEDURE Sprite_Init(VAR sprite:sprite_typ; x,y,ac,as,mc,ms,w,h:INTEGER);
  342.  
  343. VAR index:INTEGER;
  344.  
  345. BEGIN
  346. sprite.x            := x;
  347. sprite.y            := y;
  348. sprite.x_old        := x;
  349. sprite.y_old        := y;
  350. sprite.width        := w;
  351. sprite.height       := h;
  352. sprite.anim_clock   := ac;
  353. sprite.anim_speed   := as;
  354. sprite.motion_clock := mc;
  355. sprite.motion_speed := ms;
  356. sprite.cur_frame   := 1;
  357. sprite.state        := SPRITE_DEAD;
  358. sprite.num_frames   := 0;
  359. for index:=1 TO MAX_SPRITE_FRAMES DO
  360.     sprite.frames[index] := NIL;
  361. END;
  362.  
  363. PROCEDURE Sprite_Delete(VAR sprite:sprite_typ);
  364.  
  365. VAR index:integer;
  366.  
  367. BEGIN
  368. for index:=1 TO sprite.num_frames DO
  369.         freemem(sprite.frames[index],sprite.width*sprite.height)
  370. END;
  371.  
  372. PROCEDURE Get_sprite(image:pcximage;
  373.                           VAR sprite:sprite_typ;
  374.                           sprite_frame:integer;
  375.                           grab_x,grab_y:integer);
  376.  
  377. VAR x_off,y_off, x,y, index,sseg,soff,iseg,ioff:INTEGER;
  378.  
  379. BEGIN
  380. check_mem(sprite.frames[sprite_frame],sprite.width * sprite.height);
  381. x_off := (sprite.width+1)  * grab_x+1;
  382. y_off := (sprite.height+1) * grab_y+1;
  383. y_off := y_off * 320;
  384. soff:=ofs(sprite.frames[sprite_frame]^);
  385. sseg:=seg(sprite.frames[sprite_frame]^);
  386. iseg:=seg(image^);
  387. ioff:=ofs(image^);
  388. for y:=0 TO sprite.height-1 DO
  389. BEGIN
  390.   for x:=0 TO sprite.width-1 DO
  391.   BEGIN
  392.     mem[sseg:soff+y*sprite.width + x] :=mem[iseg:ioff+y_off+x_off+x];
  393.    END;
  394.   y_off:=y_off+320;
  395. END;
  396.  sprite.num_frames:=sprite.num_frames+1;
  397. END;
  398.  
  399. PROCEDURE Get_sprite_coord(image:pcximage;
  400.                           VAR sprite:sprite_typ;
  401.                           sprite_frame:integer;
  402.                           grab_x,grab_y:integer);
  403.  
  404. VAR y_off, x,y, index,sseg,soff,iseg,ioff:INTEGER;
  405.  
  406. BEGIN
  407. check_mem(sprite.frames[sprite_frame],sprite.width * sprite.height);
  408. y_off := grab_y*320+grab_x;
  409. soff:=ofs(sprite.frames[sprite_frame]^);
  410. sseg:=seg(sprite.frames[sprite_frame]^);
  411. iseg:=seg(image^);
  412. ioff:=ofs(image^);
  413. for y:=0 TO sprite.height-1 DO
  414. BEGIN
  415.   for x:=0 TO sprite.width-1 DO
  416.   BEGIN
  417.     mem[sseg:soff+y*sprite.width + x] :=mem[iseg:ioff+y_off+x];
  418.    END;
  419.   y_off:=y_off+320;
  420. END;
  421.  sprite.num_frames:=sprite.num_frames+1;
  422. END;
  423.  
  424.  
  425. PROCEDURE Behind_Sprite(VAR sprite:sprite_typ);
  426.  
  427. VAR work_offset,offset,y,sseg,soff,dseg,doff:integer;
  428.  
  429. BEGIN
  430. check_mem(sprite.background,sprite.height*sprite.width);
  431. sseg:=seg(sprite.background^);
  432. soff:=ofs(sprite.background^);
  433. dseg:=seg(double_buffer^);
  434. doff:=ofs(double_buffer^);
  435. work_offset:=0;
  436. offset := (sprite.y SHL 8) + (sprite.y SHL 6) + sprite.x;
  437. for y:=0 TO sprite.height-1 DO
  438. BEGIN
  439.   move(mem[dseg:doff+offset],mem[sseg:soff+work_offset],sprite.width);
  440.   offset:=offset+SCREEN_WIDTH;
  441.   work_offset:=work_offset+sprite.width;
  442. END;
  443. END;
  444.  
  445. PROCEDURE Erase_Sprite(VAR sprite:sprite_typ);
  446.  
  447. VAR work_offset,offset,y,sseg,soff,dseg,doff:integer;
  448.  
  449. BEGIN
  450.   sseg:=seg(sprite.background^);
  451.   soff:=ofs(sprite.background^);
  452.   dseg:=seg(double_buffer^);
  453.   doff:=ofs(double_buffer^);
  454.   work_offset:=0;
  455.   offset := (sprite.y SHL 8) + (sprite.y SHL 6) + sprite.x;
  456.   for y:=0 TO sprite.height-1 DO
  457.   BEGIN
  458.     move(mem[sseg:soff+work_offset],mem[dseg:doff+offset],sprite.width);
  459.     offset:=offset+SCREEN_WIDTH;
  460.     work_offset:=work_offset+sprite.width;
  461.   END;
  462.   freemem(sprite.background,sprite.width*sprite.height);
  463. END;
  464.  
  465. PROCEDURE Draw_Sprite_F(VAR sprite:sprite_typ);
  466.  
  467. VAR x,y,soff,sseg,dseg,doff:word;
  468.     height,width:word;
  469.  
  470. BEGIN
  471. width:=sprite.width;
  472. height:=sprite.height;
  473. x:=sprite.x; y:=sprite.y;
  474. soff:=ofs(sprite.frames[sprite.cur_frame]^);
  475. sseg:=seg(sprite.frames[sprite.cur_frame]^);
  476. dseg:=seg(double_buffer^);
  477. doff:=ofs(double_buffer^);
  478. ASM
  479. jmp @begin
  480. @plot:
  481.  mov es,dseg
  482.  mov bx,x
  483.  add bx,dx
  484.  mov es:[di+bx],cl
  485. jmp @back
  486. @begin:
  487.   mov di,doff
  488.    mov si,soff
  489.    mov dx,y
  490.    shl dx,8
  491.    mov ax,dx
  492.    shr dx,2
  493.    add dx,ax
  494.    add dx,x
  495.    mov ax,0
  496.    mov y,0
  497.    mov x,0
  498. @yloop:
  499. @xloop:
  500.  mov es,sseg
  501.  mov bx,x
  502.  add bx,ax
  503.  mov cl,byte ptr es:[si+bx]
  504.  cmp cl,0
  505.  jne @plot
  506.  @back:
  507.  inc x
  508.  mov bx,x
  509.  cmp bx,width
  510.  jne @xloop
  511.  inc y
  512.  add dx,screen_width
  513.  add ax,width
  514.  mov x,0
  515.  mov bx,y
  516. cmp bx,height
  517. jne @yloop
  518. END;
  519. END;
  520.  
  521. PROCEDURE Draw_Sprite_VBF(VAR sprite:sprite_typ);
  522.  
  523. VAR x,y,soff,sseg,dseg,doff:word;
  524.     height,width:word;
  525.  
  526. BEGIN
  527. width:=sprite.width;
  528. height:=sprite.height;
  529. x:=sprite.x; y:=sprite.y;
  530. soff:=ofs(sprite.frames[sprite.cur_frame]^);
  531. sseg:=seg(sprite.frames[sprite.cur_frame]^);
  532. dseg:=seg(double_buffer^);
  533. doff:=ofs(double_buffer^);
  534. ASM
  535. jmp @begin
  536. @plot:
  537. mov di,0a000h
  538.  mov es,di
  539.  mov bx,x
  540.  add bx,dx
  541.  mov es:[bx],cl
  542. jmp @back
  543. @begin:
  544.    mov si,soff
  545.    mov dx,y
  546.    shl dx,8
  547.    mov ax,dx
  548.    shr dx,2
  549.    add dx,ax
  550.    add dx,x
  551.    mov ax,0
  552.    mov y,0
  553.    mov x,0
  554. @yloop:
  555. @xloop:
  556.  mov es,sseg
  557.  mov bx,x
  558.  add bx,ax
  559.  mov cl,byte ptr es:[si+bx]
  560.  cmp cl,0
  561.  jne @plot
  562.  @back:
  563.  inc x
  564.  mov bx,x
  565.  cmp bx,width
  566.  jne @xloop
  567.  inc y
  568.  add dx,screen_width
  569.  add ax,width
  570.  mov x,0
  571.  mov bx,y
  572. cmp bx,height
  573. jne @yloop
  574. END;
  575. END;
  576.  
  577.  
  578. PROCEDURE Draw_Sprite(VAR sprite:sprite_typ);
  579.  
  580. VAR work_offset,offset,x,y,soff,sseg,dseg,doff:INTEGER;
  581.     data:byte;
  582.  
  583. BEGIN
  584. soff:=ofs(sprite.frames[sprite.cur_frame]^);
  585. sseg:=seg(sprite.frames[sprite.cur_frame]^);
  586. dseg:=seg(double_buffer^);
  587. doff:=ofs(double_buffer^);
  588. work_offset:=0;
  589. offset:=(sprite.y SHL 8) + (sprite.y SHL 6) + sprite.x;
  590. for y:=0 TO sprite.height-1 DO
  591. BEGIN
  592. for x:=0  TO sprite.width-1 DO
  593. BEGIN
  594.  data:=mem[sseg:soff+work_offset+x];
  595.  IF data<>0 THEN mem[dseg:doff+offset+x]:=data;
  596. END;
  597.  offset:=offset+SCREEN_WIDTH;
  598.  work_offset:=work_offset+sprite.width;
  599. END;
  600. END;
  601.  
  602. PROCEDURE Behind_Sprite_VB(VAR sprite:sprite_typ);
  603.  
  604. VAR work_offset,offset,y,sseg,soff:integer;
  605.  
  606. BEGIN
  607. check_mem(sprite.background,sprite.width*sprite.height);
  608. sseg:=seg(sprite.background^);
  609. soff:=ofs(sprite.background^);
  610. work_offset:=0;
  611. offset := (sprite.y SHL 8) + (sprite.y SHL 6) + sprite.x;
  612. for y:=0 TO sprite.height-1 DO
  613. BEGIN
  614.   move(mem[$a000:offset],mem[sseg:soff+work_offset],sprite.width);
  615.   offset:=offset+SCREEN_WIDTH;
  616.   work_offset:=work_offset+sprite.width;
  617. END;
  618. END;
  619.  
  620. PROCEDURE Erase_Sprite_VB(VAR sprite:sprite_typ);
  621.  
  622. VAR work_offset,offset,y,sseg,soff:integer;
  623.  
  624. BEGIN
  625.   sseg:=seg(sprite.background^);
  626.   soff:=ofs(sprite.background^);
  627.   work_offset:=0;
  628.   offset := (sprite.y SHL 8) + (sprite.y SHL 6) + sprite.x;
  629.   for y:=0 TO sprite.height-1 DO
  630.   BEGIN
  631.     move(mem[sseg:soff+work_offset],mem[$a000:offset],sprite.width);
  632.     offset:=offset+SCREEN_WIDTH;
  633.     work_offset:=work_offset+sprite.width;
  634.   END;
  635.   freemem(sprite.background,sprite.width*sprite.height)
  636. END;
  637.  
  638. PROCEDURE Draw_Sprite_VB(VAR sprite:sprite_typ);
  639.  
  640. VAR work_offset,offset,x,y,soff,sseg:INTEGER;
  641.     data:byte;
  642.  
  643. BEGIN
  644. soff:=ofs(sprite.frames[sprite.cur_frame]^);
  645. sseg:=seg(sprite.frames[sprite.cur_frame]^);
  646. work_offset:=0;
  647. offset:=(sprite.y SHL 8) + (sprite.y SHL 6) + sprite.x;
  648. for y:=0 TO sprite.height-1 DO
  649. BEGIN
  650. for x:=0  TO sprite.width-1 DO
  651. BEGIN
  652.  data:=mem[sseg:soff+work_offset+x];
  653.  IF data<>0 THEN mem[$a000:offset+x]:=data;
  654. END;
  655.  offset:=offset+SCREEN_WIDTH;
  656.  work_offset:=work_offset+sprite.width;
  657. END;
  658. END;
  659.  
  660. BEGIN
  661. END.
  662.  
  663.  
  664.  
  665.  
  666.  
  667.  
  668.  
  669.  
  670.