commit 6bc455f9af18e6a524e7cda31c3dc997a4352475 Author: Frater Date: Mon Jul 30 22:06:09 2018 +0200 Original source code back to 1994 diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d8fe4fa --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +/.project diff --git a/Lib-Data/ADD.BAT b/Lib-Data/ADD.BAT new file mode 100644 index 0000000..00a15bb --- /dev/null +++ b/Lib-Data/ADD.BAT @@ -0,0 +1,5 @@ +@ECHO OFF +ECHO Adding %1 to RUNES.OTL>>REM.VAL +ECHO Is Position IS (Size Of Runes Before ) >> REM.VAL +SIZEOF RUNES.OTL>>REM.VAL +COPY /B RUNES.OTL+%1 RUNES.OTL > NUL: \ No newline at end of file diff --git a/Lib-Data/FIREPIC.SCI b/Lib-Data/FIREPIC.SCI new file mode 100644 index 0000000..002beb7 Binary files /dev/null and b/Lib-Data/FIREPIC.SCI differ diff --git a/Lib-Data/FONT.SCI b/Lib-Data/FONT.SCI new file mode 100644 index 0000000..3b3e909 Binary files /dev/null and b/Lib-Data/FONT.SCI differ diff --git a/Lib-Data/GREETFNT.SCI b/Lib-Data/GREETFNT.SCI new file mode 100644 index 0000000..bc10405 Binary files /dev/null and b/Lib-Data/GREETFNT.SCI differ diff --git a/Lib-Data/INFO3.SCI b/Lib-Data/INFO3.SCI new file mode 100644 index 0000000..1375b57 Binary files /dev/null and b/Lib-Data/INFO3.SCI differ diff --git a/Lib-Data/LENS.CAL b/Lib-Data/LENS.CAL new file mode 100644 index 0000000..c545d4b Binary files /dev/null and b/Lib-Data/LENS.CAL differ diff --git a/Lib-Data/LENS.PRE b/Lib-Data/LENS.PRE new file mode 100644 index 0000000..f684975 Binary files /dev/null and b/Lib-Data/LENS.PRE differ diff --git a/Lib-Data/LOGO3.SCI b/Lib-Data/LOGO3.SCI new file mode 100644 index 0000000..290590b Binary files /dev/null and b/Lib-Data/LOGO3.SCI differ diff --git a/Lib-Data/MAKE.BAT b/Lib-Data/MAKE.BAT new file mode 100644 index 0000000..0314c97 --- /dev/null +++ b/Lib-Data/MAKE.BAT @@ -0,0 +1,20 @@ +@ECHO OFF +DEL RUNES.OTL +DEL REM.VAL +CALL ADD LOGO3.SCI +ECHO POSITION NULLE >>REM.VAL +CALL ADD PARCOD.SCI +CALL ADD PARDECOD.SCI +CALL ADD LENS.PRE +CALL ADD MAPHI.SCI +CALL ADD VIEW3.SCI +CALL ADD VIEW1.SCI +CALL ADD VIEW2.SCI +CALL ADD MOON.BUF +CALL ADD TITRE11.SCI +CALL ADD INFO3.SCI +CALL ADD VIEW4.SCI +CALL ADD Z-FIN3.SCI +CALL ADD Z-FIN4.SCI + + diff --git a/Lib-Data/MAPCOL.SCI b/Lib-Data/MAPCOL.SCI new file mode 100644 index 0000000..b412704 Binary files /dev/null and b/Lib-Data/MAPCOL.SCI differ diff --git a/Lib-Data/MAPHI.SCI b/Lib-Data/MAPHI.SCI new file mode 100644 index 0000000..b412704 Binary files /dev/null and b/Lib-Data/MAPHI.SCI differ diff --git a/Lib-Data/MASK.SCI b/Lib-Data/MASK.SCI new file mode 100644 index 0000000..d18813b Binary files /dev/null and b/Lib-Data/MASK.SCI differ diff --git a/Lib-Data/MOON.BUF b/Lib-Data/MOON.BUF new file mode 100644 index 0000000..bb0cb73 Binary files /dev/null and b/Lib-Data/MOON.BUF differ diff --git a/Lib-Data/MOON.SCI b/Lib-Data/MOON.SCI new file mode 100644 index 0000000..fcf6f91 Binary files /dev/null and b/Lib-Data/MOON.SCI differ diff --git a/Lib-Data/PARCOD.SCI b/Lib-Data/PARCOD.SCI new file mode 100644 index 0000000..91a68d7 Binary files /dev/null and b/Lib-Data/PARCOD.SCI differ diff --git a/Lib-Data/PARDECOD.SCI b/Lib-Data/PARDECOD.SCI new file mode 100644 index 0000000..6d05d62 Binary files /dev/null and b/Lib-Data/PARDECOD.SCI differ diff --git a/Lib-Data/REM.VAL b/Lib-Data/REM.VAL new file mode 100644 index 0000000..fefaada --- /dev/null +++ b/Lib-Data/REM.VAL @@ -0,0 +1,42 @@ +Adding LOGO3.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +POSITION NULLE +Adding PARCOD.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 64778 +Adding PARDECOD.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 129556 +Adding LENS.PRE to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 194334 +Adding MAPHI.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 222562 +Adding VIEW3.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 287340 +Adding VIEW1.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 352118 +Adding VIEW2.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 416896 +Adding MOON.BUF to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 481674 +Adding TITRE11.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 529966 +Adding INFO3.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 594744 +Adding VIEW4.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 659522 +Adding Z-FIN3.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 724300 +Adding Z-FIN4.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 789078 diff --git a/Lib-Data/TITRE11.SCI b/Lib-Data/TITRE11.SCI new file mode 100644 index 0000000..2cd4536 Binary files /dev/null and b/Lib-Data/TITRE11.SCI differ diff --git a/Lib-Data/VIEW1.SCI b/Lib-Data/VIEW1.SCI new file mode 100644 index 0000000..64f8d82 Binary files /dev/null and b/Lib-Data/VIEW1.SCI differ diff --git a/Lib-Data/VIEW2.SCI b/Lib-Data/VIEW2.SCI new file mode 100644 index 0000000..d2a8b78 Binary files /dev/null and b/Lib-Data/VIEW2.SCI differ diff --git a/Lib-Data/VIEW3.SCI b/Lib-Data/VIEW3.SCI new file mode 100644 index 0000000..0e83d97 Binary files /dev/null and b/Lib-Data/VIEW3.SCI differ diff --git a/Lib-Data/VIEW4.SCI b/Lib-Data/VIEW4.SCI new file mode 100644 index 0000000..0c36c9c Binary files /dev/null and b/Lib-Data/VIEW4.SCI differ diff --git a/Lib-Data/Z-FIN3.SCI b/Lib-Data/Z-FIN3.SCI new file mode 100644 index 0000000..857f888 Binary files /dev/null and b/Lib-Data/Z-FIN3.SCI differ diff --git a/Lib-Data/Z-FIN4.SCI b/Lib-Data/Z-FIN4.SCI new file mode 100644 index 0000000..ab1fee4 Binary files /dev/null and b/Lib-Data/Z-FIN4.SCI differ diff --git a/SRC/FIRE.PAS b/SRC/FIRE.PAS new file mode 100644 index 0000000..978483c --- /dev/null +++ b/SRC/FIRE.PAS @@ -0,0 +1,169 @@ +Unit Fire; +Interface + Procedure Greetings; +Implementation + +{ need a "lot" of memory (3*64Kb=196605 Bytes) 191Kb free conventional mem } +Uses + CRT,DOS,GRAPHVGA,LibUses; +Const + MAxC = $40; + { Torche } + BaseX = 30; + BaseY = 50; + MaxX = 20; + SizeX = 20; + maxXd2 = SizeX shr 1; + maxXd3 = SizeX shr 2; + AddX = MaxX; + MaxY = 30; + count1 : Word = 20; + debut = (BaseY*320)+BaseX; + BaseC = MaxY; + +Var + Buffer : Pointer; + AddX1 : Integer; + Vbuf1 : Word; + im, Im2 : ImageInfo; + +Procedure Pixel(VB,MX,My,X,Y : Word; C : Byte); +begin + If (X<1) OR (X>MX) OR (Y<1) Or (Y>MY) Then + exit; + Mem[VB:(Y-1)*MX+(x-1)] := C; +End; + +Procedure Init; +Var + X,Y : Word; +Begin + Simplebuffer; + LoadImage(Greetings1,Im); + LoadImage(Greetings2,Im2); + PutImage(Im,0); + Freeimage(Im); + GetMem(Buffer,$FFFF); + FillChar(Buffer^,$FFFF,0); + VBuf1 := seg(Buffer^); +End; + +Procedure Outit; +Begin + FreeMem(Buffer,$FFFF); +End; + +Procedure FireTorch; +Var + X,Y : Word; +Begin + For X:=1 to Count1 do + Pixel(VBuf1,MaxX,MaxY,Random(maxxd2)+(maxxd3),MaxY,MaxC); + for X:=1 to count1 shr 1 do + Pixel(VBuf1,MaxX,MaxY,Random(SizeX-maxxD2)+MaxxD3,maxy-5,MaxC-12); + for X:=1 to count1 shr 2 do + Pixel(VBuf1,MaxX,MaxY,Random(SizeX-MaxxD2)+MaxxD3,maxy-13,MaxC-15); + for X:=1 to count1 shr 3 do + Pixel(VBuf1,MaxX,MaxY,Random(SizeX-MaxxD2)+MaxxD3,maxy-20,MaxC-15); asm + cli + Push DS + mov AX,VBuf1 + mov DS,AX + mov cx,BaseC*MaxX + Mov SI,0 {(MaxY-baseC+1)*maxX} +@@BCL: xor AX,AX + xor BX,BX + mov bl,[si-1] + add ax,bx + mov bl,[si+1] + add ax,bx + mov bl,[si+MaxX] + add ax,bx + mov bl,[si-MaxX] + add ax,bx + + mov bl,[SI+MaxX-1] + add ax,bx + mov bl,[SI-MaxX-1] + add ax,bx + mov bl,[SI-MaxX+1] + add ax,bx + mov bl,[SI+MaxX+1] + add ax,bx + + shr Ax,3 + or ax,ax + je @@ne + dec AX +@@Ne: mov [SI-AddX],al + inc SI + dec CX + jnz @@BCL + Pop DS + sti + end; +End; + +Procedure PutTorche(X,Y : Word); Assembler; +Asm + cli + push DS + mov DX,VBuf1 + mov DS,DX + Mov AX,0A000h + mov ES,AX + Xor SI,SI + Mov AX,Y + Mov BX,320 + Mul BX + Add AX,X + Mov DI,AX + Mov DX,MaxX + mov BX,MaxY-3 +@@Bcl1: Mov CX,DX + Rep Movsb + Add DI,320-MaxX + dec BX + Jnz @@Bcl1 + pop DS + sti + end; + +Procedure Greetings; +var + C : Word; +Begin + Init; + C := 0; + While (C <=500) do + begin + FireTorch; + PutTorche(35,80); + PutTorche(270,80); + WaitVbl; + WaitVbl; + inc(C); + end; + FadeOut(0,$ff,1); + PutImage(im2,3); + PutTorche(35,80); + PutTorche(270,80); + FadeIn(0,$FF,Im2.palette,1); + FreeImage(Im2); + c := 0; + While (C <=500) do + begin + FireTorch; + PutTorche(35,80); + PutTorche(270,80); + WaitVbl; + WaitVbl; + inc(C); + end; + Outit; + FadeOut(0,$FF,1); +end; + +End. + + diff --git a/SRC/GRAPHVGA.PAS b/SRC/GRAPHVGA.PAS new file mode 100644 index 0000000..700ac78 --- /dev/null +++ b/SRC/GRAPHVGA.PAS @@ -0,0 +1,952 @@ +Unit GraphVGA; +interface +Uses + CRT,DOS; +Const + NormEffect = 0; + FadeEffect = 1; + noViewEfct = 2; + GetMaxX = 319; + GetMaxY = 199; + CentreX = 160; + CentreY = 100; + VGA = $13; + CGALo = $04; + CGAHi = $06; + On = True; + Off = False; + Screen : Pointer = Ptr($0000,$0000); + MagicLong : Longint = $11111111; +Type + Infor = Record + X1,Y1,X2,Y2 : Integer; + End; + PointType = Record + X,Y : Integer; + End; + ColorRGB = Record + Rouge : Byte; + Vert : Byte; + Bleu : Byte; + End; + RGB = Array[0..$FF] of ColorRGB; + ImageInfo = Record + SizeX : Word; + SizeY : Word; + Palette : RGB; + Picture : Pointer; + Size : Word; + End; +Var + PageW : Pointer; + PageWS : Word; + PageWO : Word; + WriteS : Word; + Reg : Registers; + RGBPal : RGB; + DirectV : Boolean; + VgaMode : Boolean; + Doub : Boolean; + DefSpd : Byte; + _CColor : Byte; + +Procedure pause(Speed : Word); + +Procedure SimpleBuffer; + +Procedure DoubleBuffer; + +Procedure SetDColor( c: Byte); + +Function Rad(A : Real) : real; + +Function Deg(A : Real) : Real; + +Procedure WaitVBL; + +Procedure SetRGB(Var Pal : RGB); + +Procedure GetRGB(Var Pal : RGB); + +{ Assembler : } +Procedure InitGraph( Mode : Byte ); + +Procedure CloseGraph; + +Procedure SetSpeed(Speed : Byte); +{ Assembler : } +Procedure PutPixel ( X,Y : Integer; + C : Byte); + +Function GetPixel ( X,Y : Integer) : Byte; + +Function GPixel ( X,Y : Integer) : Byte; + +Procedure ClearDevice(CColor : Byte); + +Procedure ViewPage; + +Procedure DirectVideo(Direct : Boolean); + +Function GetVideo : Boolean; + +Procedure SetColor ( Color, Red, Green, Blue : Byte ); + +Procedure SetRGBColor( Color,R,G,B : Byte; Var Pal : RGB); + +{ Assembler } +Procedure Line(X1,Y1,X2,Y2 : Integer; Color : byte); + +Procedure PaletteOff; + +{ Assembler } +Procedure FadeOut(First,Last : Word; Speed : Byte); + +Procedure FadeIn(first,Last : word; Var Pal : RGB; speed : Byte); + +Procedure FadeFromWhite(first,Last : word; Var Pal : RGB; Speed : Byte); + +Procedure FadeWhite(First,Last : Word; speed : Byte); + +Function expo(A,E : integer) : LongInt; + +Procedure PutImage( Var Im : ImageInfo; + Mo : Byte); + +Procedure AllocImage( SX,SY : Word; + Var I : imageInfo); + +Procedure FreeImage( Var I : ImageInfo); + +Procedure LoadRIX(N : String; Var Ima : Imageinfo); + +Procedure Comprs(Var Pic : Pointer; Var Taille : Word); + +Procedure UnComprs(Pic : Pointer; ToP : Pointer); + +Implementation +{ +Var + PageW : Pointer; + PageWS : Word; + PageWO : Word; + WriteS : Word; + Reg : Registers; + DirectV : Boolean; + VgaMode : Boolean; + DefSpd : Byte; + _CColor : Byte; +} + +Procedure Pause(Speed : Word); +Var + I : Word; +Begin + I := 0; + Repeat + Inc(I); + Until I>Speed; +End; + +Procedure SetDColor( c: Byte); +Begin + _CColor := C; +End; + +Function Rad(A : Real) : real; +Begin + Rad := (A*Pi)/180; +End; + +Function Deg(A : Real) : Real; +Begin + Deg := (A*180) /pi; +End; + +Procedure WaitVBL; Assembler; +Asm + { Wait VBL } + Mov DX,$3DA +@W: in AL,DX + Test AL,$08 + Jne @W + +@X: in AL,DX + test AL,$08 + Je @X +end; + +Procedure SetColor ( Color, Red, Green, Blue : Byte ); Assembler; +Asm + PushA + Mov DX,$3C8 + Mov AL,[Color] + Out DX,AL + Inc DX + Mov AL,[Red] + Out DX,AL + Mov AL,[Green] + Out DX,AL + Mov AL,[Blue] + Out DX,AL + PopA +End; + +Procedure SetRGB(Var Pal : RGB); Assembler; +Asm + Push DS + Push SI + Push DX + Push CX + Push AX + + Lds SI,[Pal] + cld + Xor CX,CX + Mov DX,$3C8 +@Beg: + Mov AL,CL + Out DX,AL + Inc DX + LodsB + Out DX,AL + Lodsb + Out DX,AL + Lodsb + Out DX,AL + inc CX + Dec DX + cmp CH,$00 + je @beg + + mov DI,offset [RGBPal] + mov ax,seg [rgbPal] + mov es,ax + Lds SI,[Pal] + mov CX,3*$FF + rep movsb + Pop AX + Pop CX + Pop DX + Pop SI + Pop DS +End; + +Procedure GetRGB(Var Pal : RGB); Assembler; +Asm + Push DS + Push SI + Push DX + Push CX + Push AX + + Les DI,[Pal] + cld + Xor CX,CX +@Beg: + Mov DX,$3C8 + Mov AL,CL + Out DX,AL + Inc DX + In AL,DX + StosB + In AL,DX + StosB + In AL,DX + StosB + inc CX + cmp CH,$00 + jz @beg + + Pop AX + Pop CX + Pop DX + Pop SI + Pop DS +End; + +Procedure SetSpeed(Speed : Byte); +Begin + DefSpd := Speed; +End; + +Procedure SimpleBuffer; +Begin + If not Doub Then Exit; + Freemem(PageW,$FFFF); + PageWS := $A000; + WriteS := $A000; + Doub := false; +End; + +Procedure DoubleBuffer; +Begin + If Doub Then Exit; + Getmem(pageW,$FFFF); + PageWS := Seg(PageW^); + WriteS := PageWS; + Doub := True; +End; + +Procedure InitGraph( Mode : Byte ); +Begin + asm + Mov AH,$00 + Mov AL,&Mode + int $10 + End; + DirectV := False; + VGAMode := True; + DefSpd := 100; + Getmem(pageW,$FFFF); + PageWS := Seg(PageW^); + WriteS := PageWS; + Screen := Ptr($A000,0000); + FillChar(PageW^,64000,0); + Doub := True; + _CColor := 15; + GetRGB(RGBPal); +End; + +Procedure CloseGraph; +Begin + If Not VGAMode Then + Exit; + If doub then + FreeMem(Pagew,$FFFF); + Asm + Mov AH,$00 + Mov AL,$03 + int $10 + End; + TextMode(CO80); +End; + +Procedure PutPixel( X,Y : Integer; + C : Byte); Assembler; +asm + Mov Ax,[X] + cmp [X],1 + jl @exit + cmp [X],320 + jg @exit + cmp [Y],1 + jl @exit + cmp [Y],200 + jg @exit + + mov ax,&WriteS + mov Es,ax + dec [x] { X-1 } + dec [y] { Y-1 } + Imul ax,[Y],$140 { Y*320 } + mov di,[X] + add di,ax { Bx := Bx+Ax } + mov al,[c] + stosb + +@exit: +End; + +Function GPixel( X,Y : Integer) : Byte; +Begin + GPixel := Mem[WriteS:(Y-1)*320+(X-1)]; +End; + +Function GetPixel ( X,Y : Integer) : Byte; +Begin + GetPixel := Mem[WriteS:(Y-1)*320+(X-1)] +End; + +Procedure ClearDevice(CColor : Byte); Assembler; +Asm + Mov CX,32000 + Mov AX,[WriteS] + Mov ES,AX + Xor DI,DI + Mov AH,[CColor] + Mov AL,AH + Rep StosW +End; + +Procedure ViewPage; Assembler; +Asm + Cmp &DirectV,0 + jne @exit + + Push DS + + Mov AX,$A000 + Mov ES,AX + Mov AX,&WriteS + Mov DS,AX + Mov CX,$7D00 + Xor Si,Si + xor Di,Di + Rep MovsW + + Pop DS +@exit: +End; + +Procedure DirectVideo(Direct : Boolean); +Begin + Case Direct Of + True : WriteS := $A000; + False : WriteS := PageWS; + End; + directV := Direct; +End; + +Function GetVideo : Boolean; +Begin + GetVideo := DirectV; +End; + +Procedure SetRGBColor( Color,R,G,B : Byte; Var Pal : RGB); +Begin + With Pal[Color] Do + Begin + Rouge := R; + Vert := G; + Bleu := B; + End; +End; + +Procedure Line(X1,Y1,X2,Y2 : Integer; Color : Byte); Assembler; +Asm + mov ax,WriteS + mov es,ax + mov si,x2 + sub si,x1 + mov ax,si + jns @1 + neg ax +@1: mov di,y2 + sub di,y1 + mov bx,di + jns @2 + neg bx +@2: cmp ax,bx + jge @3 + jmp @4 +@3: cmp ax,0 + je @fin + std + cmp si,0 + jge @5 + cld +@5: mov cx,si +@bcl1: mov ax,si + imul di + idiv cx + add ax,y1 + mov bx,ax + mov ax,320 + mul bx + add ax,x1 + add ax,si + mov bx,ax + mov al,color + mov byte ptr es:[bx],al + lodsb + cmp si,0 + jnz @bcl1 + jmp @fin +@4: xchg si,di + std + cmp si,0 + jge @6 + cld +@6: mov cx,si +@bcl2: mov bx,y1 + add bx,si + mov ax,320 + mul bx + mov bx,ax + mov ax,di + imul si + idiv cx + add ax,x1 + add bx,ax + mov al,color + mov byte ptr es:[bx],al + lodsb + cmp si,0 + jnz @bcl2 +@fin: +end; + +Procedure GetIntRGB ( Var Pal : RGB); Assembler; +asm + Mov AH,10h + mov AL,17h + Xor BX,BX + mov CX,256*3 + les dx,Pal + int 10h +End; + +Procedure PaletteOff; +Var + INPal : RGB; +Begin + fillChar(InPal,sizeOf(RGB),0); + SetRGB(InPal); +End; + +Procedure FadeOut(First,Last : Word; Speed : Byte); +Var + R,G,B : Byte; +Begin + Asm + PushA + mov bl,speed + mov si,$40 +@Gb: + Mov cx,[First] + call WaitVbl +@Rer: + { Get R,G,B } + Mov dx,$3C7 + Mov al,cl + Out dx,al + mov dx,$3C9 + + In al,dx + mov [r],Al + + In al,dx + mov [g],Al + + In al,dx + mov [b],Al + + { Decremente R,G,B } + cmp [r],0 + je @G1 + sub [R],bl + +@G1: cmp [g],0 + je @b1 + sub [g],bl + +@B1: cmp [B],0 + je @n1 + Sub [B],bl + + { Write to DAC VGA } +@N1: Mov DX,$3C8 + mov al,cl + out dx,al + inc dx + + mov al,[r] + out dx,al + + mov al,[g] + out dx,al + + mov al,[b] + out dx,al + + inc cx + cmp cx,[Last] + jbe @rer + + dec Si + cmp si,-1 + jne @GB + PopA + End; +End; + +Procedure FadeIn(first,Last : word; Var Pal : RGB; Speed : Byte); +Var + R,G,B : Byte; +Begin + Asm + PushA + Push ES + mov bl,speed + mov di,$40 +@Gb: + Mov cx,[first] + call WaitVbl +@Rer: + { Get R,G,B } + Les sI,Pal + mov dx,3 + mov ax,cx + mul dx + add si,ax + Mov dx,$3C7 + Mov al,cl + Out dx,al + mov dx,$3C9 + + In al,dx + mov [r],Al + + In al,dx + mov [g],Al + + In al,dx + mov [b],Al + + lodsb + { Decremente R,G,B } + cmp [r],al + je @G1 + add [R],bl + +@G1: lodsb + cmp [g],al + je @b1 + add [g],bl + +@B1: lodsb + cmp [B],al + je @n1 + add [B],bl + + { Write to DAC VGA } +@N1: Mov DX,$3C8 + mov al,cl + out dx,al + inc dx + + mov al,[r] + out dx,al + + mov al,[g] + out dx,al + + mov al,[b] + out dx,al + + inc cx + cmp cx,[last] + jbe @rer + + dec di + cmp di,-1 + jne @GB + Pop ES + PopA + End; +End; + +Procedure FadeFromWhite(first,Last : word; Var Pal : RGB; Speed : Byte); +Var + R,G,B : Byte; +Begin + Asm + PushA + Push DS + mov bl,speed + mov di,$40 +@Gb: + Mov cx,[first] + call WaitVbl +@Rer: + { Get R,G,B } + LDs sI,Pal + mov dx,3 + mov ax,cx + mul dx + add si,ax + Mov dx,$3C7 + Mov al,cl + Out dx,al + mov dx,$3C9 + + In al,dx + mov [r],Al + + In al,dx + mov [g],Al + + In al,dx + mov [b],Al + + lodsb + { Decremente R,G,B } + cmp [r],al + je @G1 + sub [R],bl + +@G1: lodsb + cmp [g],al + je @b1 + sub [g],bl + +@B1: lodsb + cmp [B],al + je @n1 + sub [B],bl + + { Write to DAC VGA } +@N1: Mov DX,$3C8 + mov al,cl + out dx,al + inc dx + + mov al,[r] + out dx,al + + mov al,[g] + out dx,al + + mov al,[b] + out dx,al + + inc cx + cmp cx,[last] + jbe @rer + + dec di + cmp di,$FFFF + jne @GB + Pop DS + PopA + End; +End; + +Procedure FadeWhite(First,Last : Word; Speed : Byte); +Var + R,G,B : Byte; +Begin + Asm + mov bl,speed + mov BH,040h + sub bh,bl + mov si,40h +@Gb: + Mov cx,[First] + call WaitVbl +@Rer: + { Get R,G,B } + Mov dx,$3C7 + Mov al,cl + Out dx,al + mov dx,$3C9 + + In al,dx + mov [r],Al + + In al,dx + mov [g],Al + + In al,dx + mov [b],Al + + { Incremente R,G,B } + cmp r,bh + jnb @G1 + add R,bl + +@G1: cmp G,bh + jnb @b1 + add G,bl + +@B1: cmp B,bh + jnb @n1 + add B,bl + + { Write to DAC VGA } +@N1: Mov DX,$3C8 + mov al,cl + out dx,al + inc dx + + mov al,[r] + out dx,al + + mov al,[g] + out dx,al + + mov al,[b] + out dx,al + + inc cx + cmp cx,[Last] + jbe @rer + + dec si + cmp si,-1 + jne @GB + End; + GetRGB(RGBPal); +End; + +Function expo(A,E : integer) : LongInt; +Var + E1 : Byte; + T : LongInt; +Begin + T := A; + For E1:= 1 to e-1 do + T := A * T; + Expo := T; +End; + +Procedure PutImage( Var Im : ImageInfo; + Mo : Byte); +Var + X1,Y1 : Word; + Y2 : Word; + B : Boolean; +Begin + B := GetVideo; + If Mo <> 2 Then PaletteOff; + DirectVideo(On); + With Im do + Begin + For Y1:=1 to SizeY do + Begin + Y2 := (Y1-1)*320; + X1 := (Y1-1)*SizeX; + move( Mem[Seg(Picture^): Ofs(Picture^)+X1], + Mem[WriteS:(Y2)],SizeX); + End; + DirectVideo(B); + Case Mo Of + 0 : SetRGB(Palette); + 1 : FadeIn(0,$ff,Palette,1); + 2 : SETRGB(Palette); + 3 : ; + End; + End; +End; + +Procedure AllocImage( SX,SY : Word; + Var I : imageInfo); +Var + Si : Longint; +Begin + Si := Longint(SX)*Longint(SY); + With I do + Begin + If SI > 64000 Then + SI := 64000; + GetMem(Picture,Si); + Size := Si; + SizeX := Sx; + SizeY := Sy; + End; +End; + +Procedure FreeImage( Var I : ImageInfo); +Begin + With I do + Begin + FreeMem(Picture,Size); + Size := 0; + SizeX := 0; + SizeY := 0; + End; +End; + +Procedure LoadRIX(N : String; Var Ima : Imageinfo); +Var + Header : LongInt; + F : file; + X,Y : Word; + CC : Byte; + Xs,YS : Word; + Info : Word; +Begin + Assign(F,N); + reset(F,1); + BlockRead(F,Header,4); + BlockRead(F,Xs,2); + BlockRead(F,YS,2); + BlockRead(F,Info,2); + AllocImage(Xs,Ys,Ima); + For Xs:=0 to $Ff do + With Ima do + BlockRead(F,Palette[Xs],3); + BlockRead(f,Ima.Picture^,ima.Size); + Close(F); +End; + +Procedure Comprs(Var Pic : Pointer; Var Taille : Word); +Function scan( X : Word; + C : Byte) : Byte; +Var + I : Word; + Ct : Byte; +Begin + I := X; + Ct := 0; + While (Mem[WriteS:I] = C) AND (I<64000) AND (Ct<$FF) DO + Begin + Inc(Ct); + Inc(I); + End; + Scan := Ct-1; +End; + +Var + I : Word; + R : Word; + P : Byte; + Sc : Byte; + Ts : Pointer; +Begin + getMem(Ts,64000); + I := 0; + R := 0; + Repeat + P := Scan(I,Mem[WriteS:I]); + If P > 1 Then + Begin + MemL[seg(Ts^):Ofs(Ts^)+R ] := MagicLong; + Mem[seg(Ts^):Ofs(Ts^)+R+4] := P; { Nombre de repetitions } + Mem[seg(Ts^):Ofs(Ts^)+R+5] := Mem[WriteS:I]; { Byte a r‚p‚ter } + Inc(R,6); + Inc(I,P+1); + For Sc := I to I+p+1 do + Mem[WriteS:I] := 0; + End + Else + Begin + Mem[Seg(Ts^):Ofs(Ts^)+R] := Mem[WriteS:I]; + inc(R); + Inc(I); + End; + Until I>64000; + Taille := R; + GetMem(Pic,Taille); + Move(Ts^,Pic^,Taille); + FreeMem(Ts,64000); +End; + +Procedure UnComprs(Pic : Pointer; ToP : Pointer); +Var + I,R : Word; + C : Byte; +Begin + I := 0; + R := Ofs(Pic^); + Repeat + If MemL[seg(Pic^):R ] = MagicLong Then + Begin + For C:= 0 to Mem[seg(Pic^):R+4] do + Begin + Mem[Seg(Top^):I] := Mem[seg(Pic^):R+5]; + Inc(i); + End; + Inc(R,6); + End + Else + Begin + Mem[Seg(Top^):I] := Mem[Seg(Pic^):R]; + inc(R); + Inc(I); + End; + Until I>64000; +End; + +End. \ No newline at end of file diff --git a/SRC/IFFLOAD.PAS b/SRC/IFFLOAD.PAS new file mode 100644 index 0000000..ae54ef9 --- /dev/null +++ b/SRC/IFFLOAD.PAS @@ -0,0 +1,343 @@ +Unit IFFLOAD; +interface +USES + CRT,DOS,GRAPHVGA; + +Procedure LoadIFF(N : String; Var Vers : ImageInfo); + +Procedure WaitKey; + +Implementation +Type + CmprInfo = Record + Raw : Pointer; + Size : Word; + End; + Char4 = Array[1..4] of Char; + Str4 = String[4]; + rBMHD = Record + Len : LongInt; + LX : Word; + LY : Word; + OX : Word; + OY : Word; + Plan : Byte; + Mask : Byte; + Cmprs : byte; + Dummy : Byte; + Trans : Word; + AspX : Byte; + aspY : Byte; + LaX : Word; + LaY : Word; + End; + rCRNG = Record + Len : Longint; + Dummy : Word; + Speed : Word; + Actv : Word; + LInf : Byte; + LSup : Byte; + End; + rCAMG = record + Len : LongInt; + Vport : LongInt; + end; + +Function SwapLong(L : Longint) : Longint; +Var + J,I : Byte; + L2 : LongInt; +Begin + J := 3; + For I:= 0 to 3 do + Begin + Mem[Seg(L2):Ofs(L2)+I] := Mem[Seg(L):Ofs(L)+j]; + Dec(J); + End; + SwapLong := L2; +End; + +Function SwapWord(L : Word) : Word; +Var + J,I : Byte; + L2 : word; +Begin + J := 1; + For I:= 0 to 1 do + Begin + Mem[Seg(L2):Ofs(L2)+I] := Mem[Seg(L):Ofs(L)+j]; + Dec(J); + End; + SwapWord := L2; +End; + +Function Char2Str(Source : Char4) : Str4; +Var + I : Byte; + B : Str4; +Begin + B := ''; + For I:=1 to 4 do + B := B + Source[I]; + Char2Str := B; +End; + +Procedure LoadIFF(N : String; Var Vers : ImageInfo); +Var + F : File; + Size : Longint; + Cmp : Boolean; + Plan : Byte; + TypeR : Char4; + Mask : Boolean; + ToP : Boolean; + +Procedure FORM; +Begin + BlockRead(F,Size,4); + Size := SwapLong(Size); + inc(Size,4); + BlockRead(F,TypeR,4); + If TypeR = 'ILBM' Then Top := False else + If TypeR = 'PBM ' Then Top := True; +End; + +Procedure BMHD; +Var + Chunk : rBMHD; +Begin + BlockRead(F,Chunk,Sizeof(Chunk)); + Plan := Chunk.Plan; + WIth Vers do + Begin + SizeX := SwapWord(Chunk.LX); + SizeY := SwapWord(Chunk.LY); + End; + Cmp := Chunk.Cmprs = 1; + Mask := Chunk.Mask <> 0; +End; + +Procedure CMAP; +Var + Len : Longint; + I : Longint; + J : Byte; +Begin + BlockRead(F,Len,SizeOf(Len)); + Len := SwapLong(Len); + With Vers do + Begin + FillChar(Palette,$ff*3,0); + BlockRead(F,Palette,Len); + For J:=0 to $FF do + Begin + Palette[J].Rouge := Palette[J].Rouge Shr 2; + Palette[J].Vert := Palette[J].Vert Shr 2; + Palette[J].Bleu := Palette[J].Bleu shr 2; + end; + End; +end; + +Procedure CRNG; +Var + Chunk : rCRNG; +Begin + BlockRead(F,Chunk,SizeOf(Chunk)); +End; + +Procedure CAMG; +Var +Chunk : rCAMG; +Begin + BlockRead(F,Chunk,SizeOf(Chunk)); +End; + +Procedure Put(P : Pointer; S : Word); +Var + X,Y : Word; + T : Word; + Os : ShortInt; + Sp : Word; + SW : Word; + OW : Word; + Bits : Boolean; + Buf : Pointer; + Pl : Byte; + Bc : Byte; +Begin + T := 0; + Pl := 0; + Sp := Seg(P^); + GetMem(Buf,64000); + Ow := 0; + SW := Seg(Buf^); + Ow := Ofs(Buf^); + FillChar(Buf^,64000,0); + With Vers do + Begin + For Y:=0 to 199 do + For Pl := 0 to Plan do + Begin + X := 0; + For BC:=0 to 39 do + For Os := 7 DownTo 0 do + Begin + Bits:=(Mem[SP:(Y*SizeX+(pl*40))+BC] AND (1 Shl Os))<>0; + If Bits Then + Mem[SW:Ow+((Y*320)+x)] := + Mem[SW:OW+((Y*320)+x)] + (1 Shl Pl); + inc(X); + End; + End; + end; + Move(Mem[Seg(Buf^):Ofs(Buf^)], + Mem[Seg(Vers.Picture^):Ofs(Vers.Picture^)],64000); + FreeMem(Buf,64000); +End; + +Procedure Decomprs( RAW : Pointer; + Len : Word); +Var + SegR : Word; + SegD : Word; +Begin + segR := Seg(Raw^); + With Vers do + Begin + Size := 64000; + GetMem(Picture,Size); + SegD := seg(Picture^); + End; + Asm + Push DS + Xor SI,SI + Xor DI,DI + Mov AX,[SegR] + Mov DS,AX + Mov AX,[SegD] + mov ES,ax + +@encore: + lodsb + cmp al,-128 + je @suivant + cmp al,-1 + jle @copie + { Prendre al+1 Octets } + xor cx,cx + mov cl,al + inc cx + rep Movsb + jmp @suivant + { Recopie [Si+1] 1-al fois } +@Copie: xor CX,CX + mov cl,1 + sub cl,al + lodsb + rep stosb + +@suivant:cmp SI,[Len] + jbe @encore + + Pop DS + End; +End; + +Procedure BODY; +Var + Len : Longint; + P : Pointer; +Begin + BlockRead(F,Len,4); + Len := SwapLong(Len); + GetMem(P,Len); + BlockRead(F,P^,Len); + If Cmp Then + Decomprs(P,Len) + Else + With Vers do + begin + Size := Word(Len); + GetMem(Picture,Size); + Move(P^,Picture^,Size); + End; + Case ToP of + False : Put(Vers.Picture,Vers.Size); + True :{ Move(Ptr(Seg(Vers.picture^),Ofs(Vers.picture^))^, + Ptr(Seg(Vers.picture^),Ofs(Vers.picture^)+8)^,64000)}; + End; + FreeMem(P,Len); +End; + +Procedure Unknow; +Var + L : Longint; + P : LongInt; +Begin + BlockRead(F,L,4); + L := SwapLong(L); + P := FilePos(F); + Seek(F,P+L); +End; + +Procedure DPPS; +Var + L : Longint; + P : LongInt; +Begin + BlockRead(F,L,4); + L := SwapLong(L); + P := FilePos(F); + Seek(F,P+L); + Top := True; +End; + +Procedure TINY; +Var + Len : Longint; + P : Longint; +Begin + BlockRead(F,Len,4); + Len := SwapLong(Len); + P := FilePos(F); + If (Len Mod 2) <> 0 Then + Inc(Len); + Seek(F,P+Len); +End; + +Var + Hdr : Char4; + S : Str4; + I : byte; +begin + Assign(F,N); + reset(F,1); + Top := False; + Size := 12; + While (FilePos(F) < Size) AND NOT Eof(f) do + Begin + Blockread(F,Hdr,SizeOf(Hdr)); + S := Char2Str(Hdr); + I := 0; + If S = 'FORM' Then FORM Else + If S = 'BMHD' Then BMHD Else + If S = 'CMAP' Then CMAP Else + If S = 'CRNG' Then CRNG Else + If S = 'TINY' Then TINY Else + If S = 'BODY' Then BODY Else + Unknow; + End; + Close(F); +End; + +Procedure WaitKey; +Var + C: Char; +Begin + repeat + Until KeyPressed; + C := readKey; +End; + +End. diff --git a/SRC/INTRO2.PAS b/SRC/INTRO2.PAS new file mode 100644 index 0000000..393133b --- /dev/null +++ b/SRC/INTRO2.PAS @@ -0,0 +1,72 @@ +Unit Intro2; +Interface + Procedure IntroASM; +Implementation + +Uses + CRT,DOS,GRAPHVGA,LibUses; +Var + pct : imageinfo; + Spt : Word; + +Procedure CopyBob(Y1,Y2 : word); +Var + X,Y : word; +Begin + asm + { Calcul des pts de depart } + Push DS + Mov AX,Y2 + mov BX,320 + Mul bx + Mov DI,AX { DI = DI + 289 (320-31) } + Mov AX,Y1 + Mul BX + Mov SI,AX { SI = SI + 289 (320-31) } + Mov AX,0A000h {WriteS} + Mov ES,AX + Mov AX,SPt + Mov DS,AX + Mov DX,39 +@@B1: Mov CX,160 + Rep MovsW + dec DX + jnz @@B1 + Pop DS + end; +End; + +Procedure initFont; +begin + InitGraph(VGA); + LoadImage(Title_Logo,Pct); + PutImage(Pct,1); + Delay(1000); + FadeOut(0,$FF,1); + FillChar(Screen^,64000,0); + Freeimage(Pct); + LoadImage(Title_txt,Pct); + Spt := Seg(Pct.Picture^); +end; + +Procedure IntroAsm; +Var + C : Byte; +Begin + initFont; + C := 0; + PaletteOff; + While (c<39+(4*40)) do + Begin + CopyBob(C,80); + fadein(0,4,Pct.Palette,1); + delay(1500); + fadeWhite(1,4,1); + Fadeout(0,4,1); + inc(C,40); + End; + FreeImage(Pct); +end; + +End. + diff --git a/SRC/LENS.PAS b/SRC/LENS.PAS new file mode 100644 index 0000000..1bfe7e8 --- /dev/null +++ b/SRC/LENS.PAS @@ -0,0 +1,407 @@ +Unit Lens; +Interface +Uses CRT,DOS,GraphVGA,LibUses; +{ IffLoad,LibUses;} +Const + Mx : Word = 80; + My : Word = 80; + defo : Word = 150; + size = (84*84); + O_ORG = (0*(Size*2)); + O_NORM = (1*(Size*2)); + O_TFM = (2*(Size*2)); + O_CMAP = (3*(Size*2)); + Rc : Word = 40; + RC2 : Word = 40*40; + Dis : Word = 0; + Dis2 : Word = 0; + + +Procedure InitLens; + +Procedure CloseLens; + +Procedure LensPath; + +implementation + +Var + P : ImageInfo; + P3 : ImageInfo; + Pict : Pointer; + Par : Byte; + Mx2 : Word; + Memory : Pointer; + Org : Pointer; { Array[0..Size] of Word; } + Norm : Pointer; { Array[0..Size] of word; } + TFm : Pointer; { Array[0..Size] of word; } + CMap : Pointer; { Array[0..Size] of word; } + X,Y : integer; + SX,SY : integer; + Speed : Integer; + + { +Procedure GetMask; +Var + X,Y : Word; +Begin + LoadIFF('MASK.LBM',P); + PutImage(P,3); + FreeImage(p); + DirectVideo(True); + for Y:=0 to mY-1 do + for X:=0 to mX-1 do + CMap[(Y*Mx)+X] := GetPixel(100+X,Y+1); + DirectVideo(False); +end; + +Procedure WriteMask; +Var + F : File; +Begin + Assign(F,'LENS.PRE'); + ReWrite(F,1); + BlockWrite(F,TFM,SizeOf(TFM)); + BlockWrite(F,CMap,SizeOf(CMap)); + Close(F); +End; + +Procedure ReadMask; +Var + F : File; +Begin + Assign(F,'LENS.PRE'); + Reset(F,1); + BlockRead(F,TFM,SizeOf(TFM)); + BlockRead(F,CMap,SizeOf(CMap)); + Close(F); +End; +} + +Procedure Precal; +Var + P : Pointer; + MemSeg : Word; + MemOfs : Word; +Begin + Defo := 150; + Dis := 0; + mx := 84; + my := Mx; + Rc := Mx Div 2; + RC2 := RC * Rc; + Mx2 := Mx Div 2; + + MemSeg := Seg(Memory^); + MemOfs := Ofs(Memory^); + +{ ReadMask;} + OpenSub(Lens_Precal); +{ BlockWrite(LibraryFile,Tfm,SizeOf(Tfm)); + BlockWrite(LibraryFile,Cmap,SizeOf(Cmap)); +} + P := Ptr(MemSeg,MemOfs+O_TFM); + LoadRaw(P^,Size*2); + P := Ptr(MemSeg,MemOfs+O_CMAP); + Loadraw(P^,Size*2); +{ GetMask; + WriteMask;} +End; + +Procedure InitLens; +Var + I,J : Byte; + A : Word; + f : Text; +Begin + GetMem(Memory,$FFFF); { Working memory (for transformations)} + Precal; + Par := 0; + SX := -2; + SY := -3; + X := 0; + Y := 0; + Speed := 2; + LoadImage(Parchemin_Non,P); + LoadImage(Parchemin_Code,P3); + GetMem(Pict,$FFFF); + + { + GetMem(Org,Size*Sizeof(Word)); + GetMem(Norm,Size*Sizeof(Word)); + GetMem(TFm,Size*Sizeof(Word)); + GetMem(CMap,Size*Sizeof(Word)); + } + + Move(P3.Picture^,Pict^,64000); + Move(P.Palette[0].Rouge,P.Palette[ 64].Rouge,64*3); + Move(P.Palette[0].Rouge,P.Palette[128].Rouge,64*3); + Move(P.Palette[0].Rouge,P.Palette[192].Rouge,64*3); + For J:=1 to 3 do + for I:=1 to 63 do + With P.Palette[(J*64)+I] do + Case Par Of + 0 : Begin + if Rouge-(3*j) > 0 Then dec(Rouge,(3*j)); + If Vert- (3*j) > 0 then dec(vert ,(3*j)); + If Bleu+ (2*j) < 63 Then Inc(Bleu ,(2*j)); + End; + 1 : Begin + A := (Rouge+Vert+Bleu) Div 3; + Rouge := A; + Vert := A; + Bleu := A; + End; + 2 : Begin + if Rouge-(4*j) > 0 Then dec(Rouge,(4*j)); + If Vert- (4*j) > 0 then dec(vert ,(4*j)); + If Bleu+ (8*j) < 63 Then Inc(Bleu ,(8*j)); + End; + 3 : Begin + Rouge := 0; + Vert := 0; + Bleu := 0; + End; + End; + PutImage(P,0); + Move(ptr($A000,0)^,PageW^,64000); +End; + +Procedure LensASM; +Var + Segmts: Word; { Source Segment } + SegMem: Word; { Memory Segment } + SegDat: Word; { Data Segment } + SegWrt: Word; { Write Segment } + I : Byte; + L_X2, + L_Y2 : Word; + C : Word; + L_Dss : Word; + Ofst : Word; + L_Mxx : Word; + L_MX : Word; + L_MX2 : Word; + L_MY : Word; + L_SPE : Integer; + +Begin + Move(P.Picture^,PageW^,64000); + Segmts := Seg(Pict^); + SegMem := Seg(Memory^); + SegWrt := WriteS; + L_Mxx := 320-Mx; + L_MX := MX; + L_MX2 := MX2; + L_MY := MY; + L_X2 := X; + L_Y2 := Y; + L_SPE := Speed; + + Asm + cli + Push DS + Pop AX + Mov SegDat,AX {; Preserve DATA Segment } + + Mov BX,320 + Mov AX,L_Y2 + Mul BX + Add AX,L_X2 {; AX = (Y2*320)+X2 } + Mov DX,L_MX {; DX = MX } + Mov BX,L_MX2 {; BX = MX2 } + Mov L_DSS,AX {; DSS = (Y2*320)+X2 } + Mov SI,AX +{ + For Y1:=1 to My do + For X1:=1 to Mx do + Begin + Org[C] := getPixel(X+X1,Y+Y1); + inc(C); + end; +} + Mov AX,SegMem {; ES = Memory Segment } + Mov ES,AX + + MOV DI,O_ORG {; ES:DI = MemSeg:ORG } + + Mov AX,Segmts {; Get source background image } + MOV DS,AX {; DS:SI } + +@@Bcl1: Mov CX,BX {; copy BX (MX2) Words } + rep MovsW + add SI,L_MXX {; Align to 320-MX bytes } + Dec DX {; Next Line } + Jnz @@BCL1 +{ end } + + Mov AX,SegDat {; restore DATA Segment } + Mov DS,AX + + Mov DX,L_MY + Mov DI,O_NORM + Mov SI,L_DSS + + Mov AX,SegWrt {; Get writing buffer } + Mov DS,AX + +@@Bcl5: Mov CX,BX {; copy BX (MX2) Words } + rep MovsW + add SI,L_MXX {; Align to 320-MX bytes } + Dec DX {; Next Line } + Jnz @@BCL5 + Mov AX,SegMem + MOV DS,AX {; Recover DATA SEGMENT } + + Mov AX,SegWrt {; Put New } + Mov ES,AX {; ES:DI = WriteSegment target } + Xor AX,AX + Mov CX,L_MY + Xor SI,SI + Mov DI,L_DSS {; DI = DSS (Y2*320) } +@@Bcl3: Mov DX,L_MY +@@Bcl2: Mov BX,O_TFM {; get Transistion Offset } + Mov AX,Word Ptr[BX+SI] + Mov Ofst,AX + Mov BX,O_Org {; Get Pixel Value At Ofs } + Add BX,AX + Mov AL,Byte Ptr[BX] + Mov BX,O_CMAP + cmp Word Ptr[BX+SI],0 + je @@TR1 + CMP Word Ptr[BX+SI],63 {; Bit Map normal } + Jb @@TR3 +@@TR4: Add AX,WORD Ptr[BX+SI] {; Add Color Masking } + Jmp @@TR2 + +@@TR1: Mov BX,O_NORM + Add BX,OFST + mov AL,Byte Ptr[BX] + jmp @@TR2 +@@TR3: mov AL,Byte Ptr[BX+SI] +@@TR2: inc SI + Inc SI + StosB + dec DX + Jnz @@Bcl2 + Add DI,L_MXX + Loop @@Bcl3 + + mov AX,SegWrt {; Transfert SegWrt to Screen } + Mov DS,AX + Mov CX,32000 + Xor DI,DI + Mov SI,DI + Mov AX,0A000h + mov ES,AX + rep MovsW + + MOV AX,SegDat {; Restore DS } + Mov DS,AX + + { WAIT VBL } + MOV CX,Speed + MOV DX,$3DA +@@W1: IN AL,DX + TEST AL,$08 + JNE @@W1 + +@@W2: IN AL,DX + TEST AL,$08 + JE @@W2 + DEC CX + JNZ @@W1 + + sti + end; +End; +{ +Procedure DrawMask; +Var + X,Y : Word; +Begin + DirectVideo(True); + FillChar(ptr($A000,0)^,64000,0); + for Y:=0 to mY-1 do + for X:=0 to mX-1 do + Begin + PutPixel(X+1,Y+1,Tfm[(Y*Mx)+X]); + If CMap[(Y*Mx)+X] <> 0 Then + PutPixel(100+X,Y+1,64) + Else PutPixel(100+X,Y+1,15); + end; + DirectVideo(False); +end; +} +Procedure LensPath; +var + Z : Word; +Begin + Y := 1; + setRGB(P.Palette); + Speed := 1; + While (Y<=90) do + Begin + X := 10; + While (X <=320-90) do + Begin + LensAsm; + inc(x,2); + End; + Z := 0; + While (X>10) do + Begin + LensAsm; + dec(X,5); + inc(Z); + If Z Mod 3 = 0 Then inc(Y,2); + End; + End; + X := 10; + While (X <=320-100) do + Begin + LensAsm; + inc(x,2); + End; + Z := 0; + X := 230; + Speed := 1; + Y := 101; + While (Z<10) do + begin + Inc(X,SX); + Inc(Y,SY); + if (X+SX<1) Or (X+SX > 320-90) then Begin Sx := -SX; inc(Z); end; + if (Y+SY<1) Or (Y+Sy > 200-90) then Begin SY := -SY; inc(Z); end; + LensAsm; + End; + Z:=0; + SX := -1; + Speed := 2; + Sy := 1; + While (Z<4) do + begin + Inc(X,SX); + Inc(Y,SY); + if (X+SX<1) Or (X+SX > 320-90) then Begin Sx := -SX; inc(Z); end; + if (Y+SY<1) Or (Y+Sy > 200-90) then Begin SY := -SY; inc(Z); end; + LensAsm; + End; + FadeOut(0,$FF,1); +End; + + +Procedure CloseLens; +Begin + FreeImage(P); + FreeImage(P3); + FreeMem(Pict,$FFFF); + FreeMem(Memory,$FFFF); + +{ FreeMem(Org,Size*Sizeof(Word)); + FreeMem(Norm,Size*Sizeof(Word)); + FreeMem(TFm,Size*Sizeof(Word)); + FreeMem(CMap,Size*Sizeof(Word));} +End; + +End. diff --git a/SRC/LIBUSES.PAS b/SRC/LIBUSES.PAS new file mode 100644 index 0000000..35dbff8 --- /dev/null +++ b/SRC/LIBUSES.PAS @@ -0,0 +1,148 @@ +Unit LibUses; +Interface +Uses + GRAPHVGA; +CONST + Title_Logo = 0; + Parchemin_Code = 64778; + Parchemin_Non = 129556; + Lens_Precal = 194334; + Voxel_High = 222562; + Thunder_Logo = 287340; + Thunder_Ligh = 352118; + Thunder_Dark = 416896; + Moon_walk = 481674; + Title_txt = 529966; + Thunder_Ldrk = 659522; + Vox_Info = 594744; + Greetings1 = 724300; + Greetings2 = 789078; + +{ +Adding LOGO3.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +POSITION NULLE +Adding PARCOD.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 64778 +Adding PARDECOD.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 129556 +Adding LENS.PRE to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 194334 +Adding MAPHI.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 222562 +Adding VIEW3.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 287340 +Adding VIEW1.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 352118 +Adding VIEW2.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 416896 +Adding MOON.BUF to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 481674 +Adding TITRE11.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 529966 +Adding INFO3.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 594744 +Adding VIEW4.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 659522 +Adding Z-FIN3.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 724300 +Adding Z-FIN4.SCI to RUNES.OTL +Is Position IS (Size Of Runes Before ) +Size Is : 789078 + +} + +Procedure OpenLib( N : String); + +Procedure CloseLib; + +Procedure OpenSub (Witch : Longint); + +Procedure LoadImage( Witch : LongInt; + Var Ima : ImageInfo); + +Procedure LoadData ( Witch : Longint; + Var D : Pointer; + Size : Word); + +Procedure LoadRaw ( Var D ; + Size : Word ); + +Var + LibraryFile : File; + +Implementation + +Procedure OpenLib( N : String); +Begin + Assign(LibraryFile,N); + {$I-} + Reset(LibraryFile,1); + If IOResult <> 0 Then + begin + Writeln('Oops, seem to be some problems with the data-file'); + Halt; + End; + {$I+} +End; + +Procedure CloseLib; +Begin + Close(LibraryFile); +end; + +Procedure OpenSub (Witch : Longint); +begin + Seek(LibraryFile,Witch); +end; + +Procedure Loadimage( Witch : LongInt; + Var Ima : ImageInfo); +Var + Header : LongInt; + F : file; + X,Y : Word; + CC : Byte; + Xs,YS : Word; + Info : Word; +Begin + Seek(LibraryFile,Witch); + BlockRead(LibraryFile,Header,4); + BlockRead(LibraryFile,Xs,2); + BlockRead(LibraryFile,YS,2); + BlockRead(LibraryFile,Info,2); + AllocImage(Xs,Ys,Ima); + For Xs:=0 to $FF do + With Ima do + BlockRead(LibraryFile,Palette[Xs],3); + BlockRead(LibraryFile,Ima.Picture^,ima.Size); +End; + +Procedure LoadData ( Witch : Longint; + Var D : Pointer; + Size : Word ); +Begin + Seek(LibraryFile,Witch); + BlockRead(LibraryFile,D^,size); +End; + + +Procedure LoadRaw ( Var D; + Size : Word ); +Begin + BlockRead(LibraryFile,D,size); +End; + +End. \ No newline at end of file diff --git a/SRC/MOON.PAS b/SRC/MOON.PAS new file mode 100644 index 0000000..233797c --- /dev/null +++ b/SRC/MOON.PAS @@ -0,0 +1,163 @@ +Unit Moon; +Interface +Uses + CRT,DOS,GRAPHVGA,LIBUSES; +const + MoonX = 111; + MoonY = 89; + MaskX = 151; + MaskY = 89; + +Procedure InitMoon; +Procedure CloseMoon; + +Procedure BouffeLaLune; + +Procedure GerbeLaLune; + +Implementation +Var + P : RGB; + Moon1 : Pointer; { Array of Byte; {10080 } + Moon2 : Pointer; + Mask1 : Pointer; {13680 } + Mask2 : Pointer; + +Procedure PutBob(X1,Y1,X2,Y2 : word; P : Pointer); +Begin + asm + { Calcul des pts de depart } + cli + Push DS + Mov AX,WriteS + Mov ES,AX + + Lds SI,P + INC SI + INC SI + Mov AX,Y1 + mov BX,320 + Mul bx + add ax,X1 { DI = Y2*320+X2 } + Mov Di,AX { DI = DI + 289 (320-31) } + Sub BX,X2 + + mov DX,Y2 +@@Bcl:Mov CX,X2 + rep movsb + Add DI,BX + dec dx + jnz @@Bcl + + pop DS + sti + end; +End; + +Procedure InitMoon; +var + X,Y,C : Word; +Begin + FillChar(Screen^,64000,0); + PaletteOff; + opensub(Moon_walk); + + GetMem(Moon1,10080); + GetMem(Moon2,10080); + GetMem(Mask1,13680); + GetMem(Mask2,13680); + + LoadRaw(P,SizeOf(P)); + LoadRaw(Moon1^,10080); {SizeOf(Moon1));} + LoadRaw(Moon2^,10080); {SizeOf(Moon2));} + LoadRaw(Mask1^,13680); {SizeOf(Mask1));} + LoadRaw(Mask2^,13680); {SizeOf(Mask2));} + SetRgb(P); +end; + +Procedure CloseMoon; +Begin + FreeMem(Moon1,10080); + FreeMem(Moon2,10080); + FreeMem(Mask1,13680); + FreeMem(Mask2,13680); +end; + +Procedure AddBob(X1,Y1,X2,Y2 : word; P : Pointer); +Begin + asm + { Calcul des pts de depart } + cli + Push DS + Mov AX,WriteS + Mov ES,AX + Lds SI,P + inc SI + inc SI + Mov AX,Y1 + mov BX,320 + Mul bx + add ax,X1 { DI = Y2*320+X2 } + Mov Di,AX { DI = DI + 289 (320-31) } + + Sub BX,X2 + + mov DX,Y2 +@@Bcl:Mov CX,X2 +@@Bc2:Mov AH,Byte Ptr ES:[DI] + xor AL,AL + mov AL,Byte Ptr DS:[SI] + cmp AL,0 + je @@go + inc AL +@@go: inc SI + cmp AL,16 + jbe @@ok + xor AL,AL +@@ok: Sub AH,AL + Mov AL,AH + cmp AL,0 + jnle @@sor + Xor AL,AL +@@Sor:Stosb + Loop @@Bc2 + Add DI,BX + dec dx + jnz @@Bcl + + pop DS + sti + end; +End; + +Procedure BouffeLaLune; +Var + C : Word; +Begin + For C:=0 to 138 do + begin + PutBob(160-55,100-44,MoonX,MoonY,Moon1); + AddBob(214-C,100-44,MaskX,MaskY,Mask1); + Move(Ptr(WriteS,0)^,Ptr($A000,0)^,64000); + WaitVbl; + WaitVbl; + WaitVbl; + end; +End; + +Procedure GerbeLaLune; +Var + C : Word; +Begin + For C:=138 to 138*2 do + begin + PutBob(160-55,100-44,MoonX,MoonY,Moon2); + AddBob(210-C,100-44,MaskX,MaskY,Mask2); + Move(Ptr(WriteS,0)^,Ptr($A000,0)^,64000); + WaitVbl; + WaitVbl; + WaitVbl; + end; +End; + +End. diff --git a/SRC/PASDVT.PAS b/SRC/PASDVT.PAS new file mode 100644 index 0000000..a8f4796 --- /dev/null +++ b/SRC/PASDVT.PAS @@ -0,0 +1,404 @@ +{ + PASDVT.TPU - TP(6.0) unit for interfacing to DEMOVT.EXE // ARM 12/93,4/94 + + (based on original VTASM.INC by JCAB) + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + Note: VTASM.INC nomenclature sounded a bit clumsy to me, so I decided + not to follow it too closely O:-) + + The equivalence between VTASM.INC procedures and VTDEMO.TPU ones is + as follows: + + VTDEMO.TPU VTASM.INC + ========== ========= + VT_Init InitMusic + VT_Poll CallMusic + VT_AutoOff VTDisconnectTimer + VT_AutoOn VTConnectTimer + VT_Timer VTGetTickCounter + VT_Start VTBeginSync + VT_SyncStart VTBeginSync + VTWaitForStart + VT_GoTo VTJumpPos + VT_GetSem VTCheckSemaphore (*) + VT_SetSem VTSetSemaphore + VT_Resync VTMiddleSync + VT_SetVolume VTSetSoundVolume + VT_GetVolume VTGetSoundVolume + + VT_Delay (no equivalent) + + +(*) vtasm.inc's VTCheckSemaphore compares semaphore bx with value al, +while vtdemo.tpu's VT_GetSem simply returns the value of the semaphore +and leaves any comparison up to you. + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +4/94 -- New functions: + + VT_QueryCh -- returns TRUE if note played since last query. + VT_ChStatus -- returns channel's tone, instrument, and volume. + + VT_ChannelCount -- returns number of channels + VT_CurrentPos -- returns current pattern/note + VT_Abort -- tells DVT to quit on exit + +} + +UNIT PASDVT; + +Interface + +{ ============================================================== + + T H E P R O C ' S } + + function VT_Init : boolean; { detect and initialize DEMOVT } + procedure VT_Poll; { ò 50Hz DEMOVT manual polling } + procedure VT_AutoOff; { switch to manual polling } + procedure VT_AutoOn; { switch to auto (IRQ0) polling } + function VT_Timer : longint; { get music timer count (50Hz) } + procedure VT_Start; { setup to start playing } + procedure VT_SyncStart; { Like start, but then waits 1/2 sec till music sounds } + procedure VT_GoTo( pattern, note : byte ); { jump to given pattern/note within score } + function VT_GetSem( sem : byte ) : byte; { get semaphore "sem" value } + procedure VT_SetSem( sem, va : byte ); { set semaphore "sem" to "va" } + procedure VT_Resync( sem, pattern, note : byte ); { wait for sync point } + procedure VT_SetVolume( level : byte ); { set volume level } + function VT_GetVolume : byte; { get volume level } + + procedure VT_Delay( h : word ); { delay h hundredths of a second } + { while still updating music } + + function VT_QueryCh( ChanNo : byte ) : boolean; { TRUE if new note } + procedure VT_ChStatus( ChanNo : byte; var per : word; var inst, volu : byte); + function VT_ChannelCount : byte; { get # of channels } + procedure VT_CurrentPos( var pat, note : byte ); { current pattern/note } + procedure VT_Abort; + +{ ============================================================== + + ...AND THINGS FOR ALL YOU SHOW-OFF DO-IT-YOURSELF TYPES ;-> + } +Type + TChanData = + RECORD + Period : WORD; + Ins : BYTE; + Vol : BYTE; + END; + TChansData = ARRAY[1..32] OF TChanData; + TChansTrig = ARRAY[1..32] OF BOOLEAN; + +TYPE + TVTRunInfo = + RECORD + + { Out } + + Semaphores : ARRAY[0..255] OF BYTE; + ChansTrig : TChansTrig; + + NumChannels : BYTE; + + CtrlEntryPoint : POINTER; + + TickCounter : LONGINT; + + RegEntryPoint : POINTER; + + ChansData : TChansData; + + Pos : BYTE; + Seq : BYTE; + + fill2 : ARRAY[1..81] OF BYTE; + + { In } + + fill3 : ARRAY[1..3] OF BYTE; + + JumpNewPos : BOOLEAN; + JumpPosSeq : BYTE; + JumpPosNote : BYTE; + + Volume : BYTE; + + Abort : BOOLEAN; + + fill4 : ARRAY[1..248] OF BYTE; + + END; + + VT_PInfo = ^TVTRunInfo; + VT_RInfo = TVTRunInfo; + + VTIdString = ARRAY [0..255] OF BYTE; + +var + VT_Info : VT_PInfo; { points to VT_RInfo record within DEMOVT } + AppIDFound : ^VTIdString; { dunno, ask JCAB... ;-) } + + + +Implementation + +const + VTOK : boolean = False; { = True if DEMOVT installed and initialized } + +var + VTControl : procedure ( command : word ); + + { VTInfo^.VTCtrlEntry for quick access } + { (hope DEMOVT never changes it!) } + + +procedure CLI; inline( $fa ); +procedure STI; inline( $fb ); + +{ // VT_init } + +function VT_Init : boolean; assembler; +Const + MagicAX = $5654; {'VT'} + MagicBX = $5472; {'Tr'} + MagicCX = $6163; {'ac'} + MagicXorBX = $6B65; {'ke'} + MagicXorCX = $7220; {'r '} +asm + mov ax, MagicAX + mov bx, MagicBX + mov cx, MagicCX + xor di,di + mov es, di + int 2fh + xor dl,dl + and ax,ax + jnz @no + cmp bx, MagicBX xor MagicXorBX + jne @no + cmp cx, MagicCX xor MagicXorCX + jne @no + + inc dl { DEMOVT detected! } + mov [word ptr AppIdFound+2], es + mov [word ptr AppIdFound ], di { save this... but for what ? } + + les di, [es:di-4] + mov [word ptr VT_Info+2], es + mov [word ptr VT_Info], di + + les di, [es:di+256+33] { read VTCtrlEntry vector } + mov [word ptr VTControl+2], es + mov [word ptr VTControl], di { ...and copy it to VTControl } + +@no: + xor ah, ah + mov al, dl + mov [VTOK], al +end; + + +{ // VT_Poll } + +procedure VT_Poll; +begin + if VTOK then VTControl( 2 ); +end; + + +{ // VT_AutoOff } + +procedure VT_AutoOff; +begin + if VTOK then VTControl( 1 ); +end; + + +{ // VT_AutoOn } + +procedure VT_AutoOn; +begin + if VTOK then VTControl( 0 ); +end; + + +{ // VT_Timer } + +function VT_Timer : longint; +begin + if VTOK then begin + CLI; + VT_Timer := VT_Info^.TickCounter; + STI; + end else + VT_Timer := 0; +end; + + +{ // VT_Start } + +procedure VT_Start; +begin + if VTOK then VTControl( 3 ); +end; + + +{ // VT_SyncStart } + +procedure VT_SyncStart; +begin + if VTOK then begin + VTControl( 3 ); + CLI; + VT_Info^.TickCounter := 0; + STI; + repeat VT_Poll until VT_Timer >= 25; { 25/50ths = 1/2 second } + VT_Info^.TickCounter := 0; + end; +end; + + +{ // VT_GoTo } + +procedure VT_GoTo( pattern, note : byte ); +begin + if VTOK then with VT_Info^ do begin + JumpNewPos := TRUE; + JumpPosSeq := pattern; + JumpPosNote := note; + end; +end; + + +{ // VT_GetSem } + +function VT_GetSem( sem : byte ) : byte; +begin + if VTOK then + VT_GetSem := VT_Info^.Semaphores[ sem ] + else + VT_GetSem := 0; +end; + + +{ // VT_SetSem } + +procedure VT_SetSem( sem, va : byte ); +begin + if VTOK then VT_Info^.Semaphores[ sem ] := va; +end; + + +{ // VT_Sync } + +procedure VT_Resync( sem, pattern, note : byte ); +begin + if VTOK then begin + if VT_GetSem( sem ) = 0 then VT_Goto( pattern, note ); + inc( sem ); + repeat VT_Poll until VT_GetSem( sem ) <> 0; + end; +end; + + +{ // VT_SetVolume } + +procedure VT_SetVolume( level : byte ); +begin + if VTOK then VT_Info^.Volume := level; +end; + + +{ // VT_GetVolume } + +function VT_GetVolume : byte; +begin + if VTOK then + VT_GetVolume := VT_Info^.Volume + else + VT_GetVolume := 0; +end; + + +{ // VT_Delay } + +procedure VT_Delay( h : word ); +var l : longint; +begin + if VTOK then begin + l := VT_Timer + h shr 1; + repeat VT_Poll until VT_Timer >= l; + end; +end; + + +{ // VT_QueryCh } + +function VT_QueryCh( ChanNo : byte ) : boolean; +begin + VT_QueryCh := false; + if VTOK then + if VT_Info^.ChansTrig[ ChanNo ] then begin + VT_QueryCh := true; + VT_Info^.ChansTrig[ ChanNo ] := false; + end; +end; + + +{ // VT_ChStatus } + +procedure VT_ChStatus( ChanNo : byte; var per : word; var inst, volu : byte); +begin + if VTOK then + with VT_Info^.ChansData[ ChanNo ] do begin + per := period; + inst := ins; + volu := vol; + end + else begin + per := 0; + inst := 0; + volu := 0; + end; +end; + + +{ // VT_Channels } + +function VT_ChannelCount : byte; +begin + if VTOK then + VT_ChannelCount := VT_Info^.NumChannels + else + VT_ChannelCount := 0; +end; + + +{ // VT_CurrentPos } + +procedure VT_CurrentPos( var pat, note : byte ); +begin + if VTOK then + with VT_Info^ do begin + pat := seq; + note := pos; + end + else begin + pat := 0; + note := 0; + end; +end; + + +{ // VT_Abort } + +procedure VT_Abort; +begin + if VTOK then VT_Info^.Abort := true; +end; + + +END. + diff --git a/SRC/PRESENT.PAS b/SRC/PRESENT.PAS new file mode 100644 index 0000000..19a4646 --- /dev/null +++ b/SRC/PRESENT.PAS @@ -0,0 +1,63 @@ +Unit Present; +Interface + Procedure Thunder; +implementation + +Uses + CRT,DOS,LIBUses,GraphVGA; +Var + P1,P2 : Imageinfo; + +Procedure Strike(J,I : Byte); +Var + C : Byte; +begin + Move(P1.Picture^,Ptr($A000,0)^,64000); + SetRGB(P1.Palette); + for C:=0 to J do + WaitVbl; + Move(P2.Picture^,Ptr($A000,0)^,64000); + SetRGB(P1.Palette); + For C:=0 to I do + WaitVbl; +End; + + +Procedure Thunder; +Var + P,C : Word; +Begin + P := 0; + loadImage(Thunder_Ligh,P1); + LoadImage(Thunder_Dark,P2); + P := 0; + While (P <= 15) do + Begin + putImage(P2,2); + For c:=0 to 5 do + waitvbl; + Strike(Random(5),Random(50)); + inc(p); + End; + FreeImage(p1); + FreeImage(P2); + LoadImage(Thunder_Logo,P1); + LoadImage(Thunder_Ldrk,P2); + P := 0; + While (P <= 9) do + Begin + putImage(P2,2); + For c:=0 to 5 do + waitvbl; + Strike(Random(5),Random(50)); + inc(p); + End; + FreeImage(P1); + FreeImage(P2); +End; + + +End. + + + diff --git a/SRC/TOTAL.OTL b/SRC/TOTAL.OTL new file mode 100644 index 0000000..b0f7de1 Binary files /dev/null and b/SRC/TOTAL.OTL differ diff --git a/SRC/TOTAL1.PAS b/SRC/TOTAL1.PAS new file mode 100644 index 0000000..fbc48e2 --- /dev/null +++ b/SRC/TOTAL1.PAS @@ -0,0 +1,56 @@ +Program DEMO; +Uses +{ PASDVT } + CRT,DOS,GRAPHVGA,LibUses,Intro2,Present,Moon,lens,voxel,Fire; +{Var + P : imageInfo; } +Begin + +{ IF NOT VT_Init THEN BEGIN { Init DEMOVT } +{ WriteLn('Missing Player !'); { check if DEMOVT a-ok } +{ HALT(1); + END; + VT_AutoOn; + Vt_SyncStart;} + CheckBreak := False; + InitGraph(VGA); + DirectVideo(False); +{ DirectVideo(True);} + OpenLib('TOTAL.OTL'); + + { SEGMENT : INTRO } + introAsm; + + { SEGMENT : TITLE } + Thunder; + + { SEGMENT : MOON } + InitMoon; + BouffeLaLune; + CloseMoon; + + { SEGMENT : LENS } + InitLens; + LensPath; + CloseLens; + + { SEGMENT : VOXEL } + InitVoxel; + FolowPath; + CloseVoxel; + + { SEGMENT : MOON 2 } + InitMoon; + ClearDevice(0); + GerbeLaLune; + CloseMoon; + delay(100); + FadeOut(0,$FF,1); + + { SEGMENT : Close & Grettings } + Greetings; + + { END } + CloseGraph; + CloseLib; +End. diff --git a/SRC/VOXEL.PAS b/SRC/VOXEL.PAS new file mode 100644 index 0000000..49ee9b4 --- /dev/null +++ b/SRC/VOXEL.PAS @@ -0,0 +1,395 @@ +Unit Voxel; +Interface +Uses + CRT,DOS,GRAPHVGA,Libuses; +const + Mult = 512; + Divs = Mult; + Sword= 9; + Modul = 5; + Ang : Word = 0; + Dist = 1; + AddX = 1000; + Multip = 2; + MX : Integer = 200; { -400 } + MY : Integer = 1; + MZ : Integer = 1; + +{ Mx = Mult*100; + MY = Mult; { 5 } +{ Mz = Mult; { 8 } +{ Mx = 20; + MY = 70; 5 + Mz = 20; 8 } +{ + YLen : Array[-60..-20] Of Byte = + ( 4, 4, 4, 4, 4, 4, 4, 4, 4 ,4, 4, 4, 4, 4, + 6, 6, 6, 6, 6, 6, 6, 6, 6 ,6, 6, 6, 6, + 8, 8, 8, 8, 8, 8, 8, 8, 8 ,8, 8, 8, 8, 8); +} + LX : Array[-60..-20] of Byte = + ( 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 3, 3, 3, 3, 3); +{ + Db : Array[-60..-19,0..15] of byte = ( +( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15), +( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15), +( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15), +( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15), +( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15), +( 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7), +( 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7), +( 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7), +( 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7), +( 0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5), +( 0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5), +( 0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5), +( 0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5), +( 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3), +( 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3), +( 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3), +( 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3), +( 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3), +( 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3), +( 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3), +( 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3), +( 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2), +( 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2), +( 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2), +( 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2), +( 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 2, 2), +( 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 2, 2), +( 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 2, 2), +( 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 2, 2), +( 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1), +( 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1), +( 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1), +( 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1), +( 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1), +( 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1), +( 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1), +( 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1), +( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1), +( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1), +( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1), +( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1), +( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1)); +} + Procedure InitVoxel; + Procedure FolowPath; + Procedure CloseVoxel; + +Implementation +Var + P : ImageInfo; + H : ImageInfo; + Sinus, + Cosin : Array[ 0..359] of Integer; + { Delta : Array[-49..49] of Shortint;} + OldY : integer; + SegP : Word; + segH : WOrd; + PX,Py : integer; + Writ : Byte; + + +Procedure InitVoxel; +Var + I : Word; + X,Y : Word; +Begin + LoadImage(Voxel_High,H); +{ LoadImage(Voxel_Color,P); + Loadrix('MapHi.sci',H); } + LoadImage(Vox_info,P); + Move(P.Picture^,PageW^,64000); + PutImage(P,3); + FreeImage(P); + SetRGb(H.Palette); + SegP := Seg(H.Picture^); + SegH := segP; {Seg(H.Picture^);} + PX := 160; + Py := 100; + For I:=0 to 359 do + Begin + Cosin[i] := Round(cos(Rad(I))*Mult); + Sinus[i] := Round(sin(Rad(I))*Mult); + end; + Fillchar(Ptr($A000,0)^,32000,0); + Fillchar(Ptr(WriteS,0)^,32000,0); + Ang := 0; +End; + +Procedure HLine(X,Y : integer; Co : Byte; L,H : Word); Assembler; + Asm + Mov AX,WriteS + Mov ES,AX + mov CX,L + mov AX,Y + mov BX,X + dec BX + dec AX + cmp AX,0 + jl @@Out + cmp AX,199 + ja @@Out + cmp BX,0 + jl @@inv + cmp bx,320 + jae @@out + mov DX,BX + add DX,CX + cmp dx,310 + jg @@too + jmp @@ok +@@inv: + Add Cx,bx + mov Bx,0 + jmp @@ok +@@too: + sub Dx,320 + Sub CX,DX + shr cx,1 + dec CX +@@ok: + cmp Cx,0 + jle @@out +{ shr CX,1} + mov DX,320 + Mul DX + Add BX,AX + Mov SI,H + shl si,1 +@@Dn: + mov AL,Co + Mov AH,AL + Mov DX,CX +@@Ec: + Mov CX,DX + + Mov DI,BX + Rep StosW + Add BX,320 + cmp BX,64000 + ja @@out + Dec SI + Jnz @@ec + Jmp @@Out +@@out: + end; + +Procedure DrawVoxel; +Label + Out; +var + X,Y,Z : Integer; + Zcal : Integer; + ZLen : Byte; + YC : Word; + Nx,Ny : Word; + X1,Y1 : integer; + C : Byte; + R : Shortint; + Q : Integer; + regX,RegY : Integer; + Higher : Integer; + Hig : Integer; + Delta : Array[-50..50] of Byte; +Begin + Asm + mov AX,WRITES + Mov ES,AX + xor DI,DI + Mov DX,33*160 + Mov AX,0303h + Mov BX,3 +@@B: Mov CX,DX + Rep STOSW + dec AH + dec AL + dec BL + jnz @@b +{ Mov Cx,16000 + xor AX,AX + rep StosW} + End; + RegX := Cosin[ang]; + regY := Sinus[ang]; + inc(px, -(OldY*RegY) Div Divs); + inc(Py, (OldY*RegX) Div Divs); +{ If Py >= 200 Then PY := 0; + if Px >= 320 Then PX := 0; + if Py < 0 Then Py := 199; + if Px < 0 then Px := 319;} + YC := 0; + NX := PX+((-(18)*RegY) Div divs); + NY := PY+(((18)*RegX) Div Divs); +{ Higher := Mem[SegH:(NY*320)+NX];} +{ Asm + Mov DX,$3C8 + Mov AL,0 + Out DX,AL + Inc DX + Mov AL,60 + Out DX,AL + Out DX,AL + Out DX,AL + End;} + For Z:=-60 to -20 do + Begin + Asm + Mov AX,Z + Mov BX,AX + Imul Mz + Mov Zcal,AX + End; + For X:=-49 to 48 do { 49 48 } + begin + Asm + { ; Calcul de NX } + Mov CL,9 + Mov AX,X + IMul RegX + Sar AX,CL + Cmp DX,0 + js @@N1 + AND AX,07FFFh +@@N1: Mov BX,AX + Mov AX,Yc + Sub AX,60 + Imul RegY + Sar AX,Cl + Cmp DX,0 + js @@N2 + AND AX,07FFFh +@@N2: Add BX,AX + Add BX,PX + Mov NX,BX + { ; Calcul de NY } + Mov AX,X + IMul RegY + Sar AX,CL + Cmp DX,0 + js @@N3 + AND AX,07FFFh +@@N3: Mov BX,AX + Mov AX,Yc + Sub AX,60 + Imul RegX + Sar AX,Cl + Cmp DX,0 + js @@N4 + AND AX,07FFFh +@@N4: Sub BX,AX + Add BX,PY + Mov NY,BX + { ; Calcul de l'offset NY * 320 + Nx :) } + Mov AX,NY + Mov BX,320 + Mul BX + Add AX,NX + Mov DI,AX + { ; Prise de C et Hig } + Mov AX,SegP + Mov ES,AX + Mov Al,Byte Ptr ES:[DI] + Mov C,AL + Mov AX,Segh + Mov ES,AX + xor AH,AH + Mov Al,Byte Ptr ES:[DI] + { ; Calcul du Y } + Xor AH,AH + neg AX +{ Sub AX,Higher} + Mov CL,Multip { 5 } + sal AX,Cl + Add AX,AddX {-2000 -2500 } + Mov Y,AX + + IMul My + Idiv ZCal + add AX,30 { 160 } + Mov Y1,AX + + Cmp AX,0 + Jl Out + Cmp AX,199 + Ja Out + Mov BX,AX + { ; Calcul de X1 } + Xor DX,DX + Mov AX,X + IMul Mx + IDiv Zcal + Add AX,160 + Mov X1,AX + + Cmp AX,319 + Ja Out + end; +{ Putpixel(160+X,120+Z,C); +{ PutPixel(X1,Y1,C-db[Z,C mod 16]);} + Hline(X1,Y1,C,lx[z] shl 1,y shr 7); +{ Hline(X1,Y1,C,Lx[Z],C-Delta[X]);} + Delta[X] := C*2; +OUT: + End; + inc(Yc); + + end; + Asm + Mov BX,DS + Mov AX,$A000 + Mov ES,AX + Mov AX,WriteS + Mov DS,AX + Mov CX,32000 + Xor DI,DI + Mov SI,DI + Rep MovsW + Mov DS,BX + End; + for x := 0 to 1 do + WaitVBL; +end; + +Procedure FolowPath; +Var + Count : Word; +Begin + Ang := 90; + OldY := 2; + For Count := 0 to 200 do + Begin + DrawVoxel; + asm + Mov DX,Ang + add DX,1 + cmp DX,360 + jb @@cont + mov DX,0 +@@Cont: Mov Ang,DX + Cmp Count,100 + jb @@out + Mov OldY,5 +@@out: + End; + end; + FadeOut(0,$FF,1); + FillChar(screen^,64000,0); +End; + +Procedure CloseVoxel; +begin + Freeimage(P); + FreeImage(H); +end; + +End. + + + +