Collection of Hack-Phreak Scene Programs/cleanhpvac.zip/cleanhpvac/PINBSRC.ZIP/_VIDEO.PAS

Pascal/Delphi Source File | 1996-02-02 | 9KB | 513 lines

procedure video_mode(mode:byte);
begin
      asm
        mov  AH,00
        mov  AL,mode
        int  10h
      end;
end;


procedure vga320x400Overscan; assembler;
asm
  mov ax,0013h     { mode 13h, 320x200x256x1 }
  int 10h
  mov dx,03c4h
  mov ax,0604h     { unchain stuff: 320x200x256x4 }
  out dx,ax
  mov ax,0f02h
  out dx,ax

  mov cx,320*200
  mov es,vseg
  xor ax,ax
  mov di,ax
  rep stosw
  mov dx,03d4h

{ set 'overscan' mode here! }
  cmp overscan,0
  jz @@weiter1
    mov dx,03c2h
    mov al,10100011b
    out dx,al
  @@weiter1:

  mov dx,03d4h

  cmp highres,0
  jz @@weiter2
    mov ax,4009h
    out dx,ax
  @@weiter2:

  mov ax,0014h
  out dx,ax
  mov ax,0e317h
  out dx,ax{}
end;

procedure Set_RGB_color(co,r,g,b:byte); assembler;
asm
  mov dx,$3c8
  mov al, co
  out dx,al

  mov dx,$3c9

  mov al, r
  out dx,al

  mov al, g
  out dx,al

  mov al, b
  out dx,al
end;

procedure retrace; assembler;
asm
  mov dx,3dah
 @vert1:
  in al,dx
  test al,8
  jz @vert1
 @vert2:
  in al,dx
  test al,8
  jnz @vert2
end;

procedure setaddress(ad:word); assembler;
asm
  mov dx,3d4h
  mov al,0ch
  mov ah,[byte(ad)+1]
  out dx,ax
  mov al,0dh
  mov ah,[byte(ad)]
  out dx,ax
end;

procedure setlinecomp(ad:word); assembler;
asm
  mov dx,3d4h
  mov al,18h
  mov ah,[byte(ad)]
  out dx,ax
  mov al,7
  out dx,al
  inc dx
  in al,dx
  dec dx
  mov ah,[byte(ad)+1]
  and ah,00000001b
  shl ah,4
  and al,11101111b
  or al,ah
  mov ah,al
  mov al,7
  out dx,ax
  mov al,9
  out dx,al
  inc dx
  in al,dx
  dec dx
  mov ah,[byte(ad)+1]
  and ah,00000010b
  shl ah,5
  and al,10111111b
  or al,ah
  mov ah,al
  mov al,9
  out dx,ax
end;

procedure Getfont;

begin
  FSeg := Seg(Font);
  FOfs := Ofs(Font);
end;

procedure cls; assembler; asm
  mov es,vseg; mov di,0; mov cx,8000; mov dx,3c4h
  mov ax,0f02h; out dx,ax; xor ax,ax; rep stosw;
end;

procedure clsvir; assembler; asm
  mov es,vseg; mov di,0; mov cx,8000; mov dx,3c4h
  mov ax,0f02h; out dx,ax; xor ax,ax; rep stosw;
end;

procedure flip(src,dst:word); assembler; asm { copy virt scr to visual scr }
  push ds; mov es,[dst]; mov ds,[src]; xor si,si
  xor di,di; mov cx,32000; rep movsw; pop ds;
end;

procedure flip_led_1;
var z:byte;
    z1,z2:word;
begin
  for z:=0 to 22 do
  begin
    z1:=z*80;
    z2:=z*160;
    asm
      push si
      push di
      push ds
      push es
      push cx
      push dx

      mov dx,03c4h
      mov ax,258
      out dx,ax
      mov es,[vseg]   {ES:DI}
      mov ds,[ledseg] {DS:SI}
      mov si,z1
      mov di,z2
      mov cx,40
      rep movsw {}

      pop dx
      pop cx
      pop es
      pop ds
      pop di
      pop si
    end;
  end;
end;

procedure flip_led_2;
var z:byte;
    z1,z2:word;
begin
  for z:=0 to 22 do
  begin
    z1:=z*80+1920;
    z2:=z*160;
    asm
      push si
      push di
      push ds
      push es
      push cx
      push dx

      mov dx,03c4h
      mov ax,1026
      out dx,ax
      mov es,[vseg]   {ES:DI}
      mov ds,[ledseg] {DS:SI}
      mov si,z1
      mov di,z2
      mov cx,40
      rep movsw {}

      pop dx
      pop cx
      pop es
      pop ds
      pop di
      pop si
    end;
  end;
end;

procedure FLIP_LED;
begin
 flip_led_1;
 flip_led_2;
 led_status:=0;
end;

procedure set_sprite(x,y:word;breite:word;hoehe, spriteseg, spriteoffs:word);
var  addr1,addr2:word;
     loop:byte;
     yact,SpriteOffsAct:word;
     VGAOffs:word;
     LaengeAct:word;
     xdiv4:word;
     yphoehem1:word;
begin
  inc(y,49);
  LaengeAct:=Breite div 8;
  XDIV4:=x div 4;
  SpriteOffsAct:=SpriteOffs;
  yphoehem1:=y+hoehe;
  for loop:=x mod 4 to (x mod 4)+3 do
  begin
    addr1:=SetSprite_VGAADR[loop];
    asm
      push ax
      push si
      push di
      push es
      push cx
      push dx

      mov dx,03c4h  {1 Durchgang}
      mov ax,addr1
      out dx,ax

      mov ax,y
      mov yact,ax
      @fortodo:
        push ds
        mov ax,yact
        mov cx,80
        mul cx
        add ax,XDIV4
        mov VGAOffs,ax

        mov al,loop
        cmp al,3
        jng @l1
          inc VGAOffs
        @l1:
        mov es,[vseg]
        mov di,[VGAOffs]
        mov ds,[SpriteSeg]
        mov si,[SpriteOffsAct]
        mov cx,[LaengeAct]
        rep movsw
        mov [SpriteOffsAct],si
        pop ds
        inc yact
        mov ax,yact
        cmp ax,yphoehem1
      jnz @ForToDo
      pop dx
      pop cx
      pop es
      pop di
      pop si
      pop ax
    end;
  end;
end;

procedure get_sprite(x,y:word;breite:byte;hoehe, spriteseg, spriteoffs:word);
var  addr1,addr2:word;
     loop:byte;
     yact,SpriteOffsAct:word;
     VGAOffs:word;
     LaengeAct:word;
     xdiv4:word;
     yphoehem1:word;
begin
  inc(y,49);
  LaengeAct:=Breite div 8;
  XDIV4:=x div 4;
  SpriteOffsAct:=SpriteOffs;
  yphoehem1:=y+hoehe;
  for loop:=x mod 4 to (x mod 4)+3 do
  begin
    addr1:=GetSprite_VGAADR[loop];
    asm
      push ax
      push si
      push di
      push es
      push cx
      push dx

      mov dx,03ceh
      mov ax,addr1
      out dx,ax

      mov ax,y
      mov yact,ax
      @fortodo:

        push ds
        mov ax,yact
        mov cx,80
        mul cx
        add ax,XDIV4
        mov VGAOffs,ax

        mov al,loop
        cmp al,3
        jng @l1
          inc VGAOffs
        @l1:

        mov ds,[vseg]
        mov si,[VGAOffs]
        mov es,[SpriteSeg]
        mov di,[SpriteOffsAct]
        mov cx,[LaengeAct]
        rep movsw
        mov [SpriteOffsAct],di
        pop ds
        inc yact
        mov ax,yact
        cmp ax,yphoehem1
      jnz @ForToDo
      pop dx
      pop cx
      pop es
      pop di
      pop si
      pop ax
    end;
  end;
end;

procedure draw_Arm_links_msk;
var z1,z2,z5:word;
    z6,z7:word;
    x,y:longint;
    z8,z9,z10:word;
begin
  z8:=ArmBreiteLinks*ArmHoeheLinks;
  z9:=ArmBreiteLinks div 8 * 2;
  z10:=ArmHoeheLinks div 2;
  z5:=(arm_links_status-1)*z8;
  z6:=seg(tableground3^);
  z7:=seg(arm_links_msk^);

  for x:=0 to ArmBreiteLinks-1 do
    asm
     mov ax,word(x)
     add ax,ArmXLinks
     mov cx,200
     mul cx
     add ax,ArmYLinks
     Sub ax,399
     mov z1,ax

     mov ax,word(x)
     mul ArmHoeheLinks
     add ax,z5
     mov z2,ax

      push ds
      mov es,z6 {ES:DI DESTINATION}
      mov di,z1
      mov ds,z7 {DS:SI SOURCE}
      mov si,z2
      mov cx,z10
      rep movsw
      pop ds
    end;
end;

procedure draw_Arm_Rechts_msk;
var z1,z2,z5:word;
    z6,z7:word;
    x,y:word;
    z8,z9,z10:word;
begin
  z8:=ArmBreiteRechts*ArmHoeheRechts;
  z9:=ArmBreiteRechts div 8 * 2;
  z10:=ArmHoeheRechts div 2;
  z5:=(arm_Rechts_status-1)*z8;
  z6:=seg(tableground3^);
  z7:=seg(arm_Rechts_msk^);

  for x:=0 to ArmBreiteRechts-1 do
    asm
     mov ax,word(x)
     add ax,ArmXRechts
     mov cx,200
     mul cx
     add ax,ArmYRechts
     Sub ax,399
     mov z1,ax

     mov ax,word(x)
     mul ArmHoeheRechts
     add ax,z5
     mov z2,ax

      push ds
      mov es,z6 {ES:DI DESTINATION}
      mov di,z1
      mov ds,z7 {DS:SI SOURCE}
      mov si,z2
      mov cx,z10
      rep movsw
      pop ds
    end;
end;

procedure draw_ARM_LINKS;
var SpriteOffs:word;
begin
  SpriteOffs:=(Arm_links_status-1)*ArmBreiteLinks*ArmHoeheLinks;
  Set_Sprite(ArmXLinks,ArmYLinks,ArmBreiteLinks,ArmHoeheLinks,ArmLinksSeg,SpriteOffs);
  draw_arm_links_msk;
end;

procedure draw_ARM_Rechts;
var SpriteOffs:word;
begin
  SpriteOffs:=(Arm_Rechts_status-1)*ArmBreiteRechts*ArmHoeheRechts;
  Set_Sprite(ArmXRechts,ArmYRechts,ArmBreiteRechts,ArmHoeheRechts,ArmRechtsSeg,SpriteOffs);
  draw_arm_Rechts_msk;
end;

procedure put_pixel(x,y:word; col:byte); assembler;
asm
  mov dx,03c4h
  mov al,2
  mov cx,[x]
  and cx,3
  mov ah,1
  shl ah,cl
  out dx,ax
  mov es,vseg
  mov ax,[y]
  shl ax,4
  mov di,ax
  shl ax,2
  add di,ax
  mov dx,[x]
  shr dx,2
  add di,dx
  mov al,[col]
  mov [es:di],al
end;

function get_pixel(x,y:word):byte;
var addr1:word;
begin
  addr1:=GetSprite_VGAADR[x mod 4];
  asm
    push ax
    push dx
    mov dx,03ceh
    mov ax,addr1
    out dx,ax
    pop dx
    pop ax
  end;
  get_pixel:=mem[$a000:y*80+x div 4];
end;

procedure put_pixel_led(x,y:word; color:byte);
begin
  MEM[ledseg: (x div 2) + ((x and 1)*1920)+y*80]:=color;
end;

procedure set_feder;
var x,y,z:word;
begin
  z:=0;
  for y:=400+205 to 400+205+startpow div 5 do begin
    for x:=federx to federx+federbreite-1 do begin
      put_pixel(x,y,0);
    end;
  end;
  for y:=federy to federy+federhoehe do begin
    for x:=federx to federx+federbreite-1 do begin
      put_pixel(x,y,mem[federseg:z]);
      inc(z);
    end;
  end;
end;