{ // SKY EFFECTS // }
{$G+,X+,N-,S-,R-}
UNIT SKY;
Interface
Uses Global, PASDVT;
procedure Zilch;
procedure InitTTY;
procedure ZeroTimer;
procedure PutText;
type
RSSchedule = record
when : longint;
first,
what,
last : procedure;
end;
const
NSScript = 4;
SScript : array[0..NSScript-1] of RSSchedule = (
( when: 0; first:Zilch; what:Zilch; last:Zilch ),
( when: 120; first:InitTTY; what:Zilch; last:Zilch ),
( when: 150; first:ZeroTimer; what:PutText; last:Zilch ),
( when: 90000; first:Zilch; what:Zilch; last:Zilch )
);
Implementation
procedure SkyPutPixel( X, Y : integer; C : byte ); external;
procedure SkyWriteCh ( X, Y : integer; cc : char; col : byte ); external;
procedure SkyCursor ( X, Y : integer; col : byte ); external;
{$L usky.obj}
procedure FONT; external;
{$L font.oof}
const { pixel coords of origin of "text" window: }
X0 = 8; { this MUST be even for USKY.ASM (besides, word aligned is faster) }
Y0 = 10;
TempCol = 233; { 201, 217, 233 }
NormCol = 201;
CurCol = 201;
var
QQ : array[0..2,0..16] of byte;
Qh : byte;
Qa : boolean;
cX : integer; { cursor pos (char) }
cY : integer;
pX : integer; { cursor pos (pixel) }
pY : integer;
bCur : boolean;
cTXT : array[0..2,0..16] of char;
procedure CalcPixel; assembler;
asm
mov bx, &cX { x = X0 + cX shl 4 + cX shl 1 }
lea ax, [X0+bx]
add ax, bx
shl bx, 4
add ax, bx
mov [pX], ax
mov bx, cY { y = Y0 + cY shl 5 + cY shl 1 }
lea ax, [Y0+bx]
add ax, bx
shl bx, 5
add ax, bx
mov [pY], ax
end;
procedure DrawCursor;
begin
CalcPixel;
if not bCur then Exit;
SkyCursor( pX, pY, CurCol );
end;
procedure EraseCursor;
begin
if not bCur then Exit;
if cTXT[cY,cX] = ' ' then
SkyCursor( pX, pY, 0 )
else
SkyWriteCh( pX, pY, cTXT[cY,cX], NormCol );
end;
procedure CursorOff;
begin
bCur := False;
end;
procedure CursorOn;
begin
bCur := True;
end;
procedure InitTTY;
begin
cX := 0; cY := 0; FillChar( cTXT, sizeof(cTXT), ' ' );
Qh := 0; Qa := FALSE; FillChar( QQ, sizeof(QQ), 0 );
CursorOn;
DrawCursor;
end;
procedure ClearCursorLine;
var x, i : integer;
begin
CalcPixel;
x := X0;
for i := 0 to 16 do begin
if cTXT[ cY,i ] <> ' ' then begin
SkyCursor( x, pY, 0 );
cTXT[ cY,i ] := ' ';
end;
inc( x, 18 );
end;
end;
procedure CurUp; assembler; { cursor up w/ wrap-around }
asm
dec [cY]
jns @1
mov ax, 2
mov [cY], ax
@1:
end;
procedure CurDn; assembler; { cursor down w/ wrap-around }
asm
inc [cY]
cmp [cY], 3
jne @1
xor ax,ax
mov [cY], ax
@1:
end;
procedure CurLf; assembler; { cursor left w/ wrap-around }
asm
dec [&cX]
jns @1
mov ax,16
mov [&cX], ax
@1:
end;
procedure CurRt; assembler; { cursor right w/ wrap-around }
asm
inc [&cX]
cmp [&cX],17
jne @1
xor ax, ax
mov [&cX], ax
@1:
end;
procedure CurFw; assembler; { cursor forward w/ wrap-around }
asm
inc [&cX]
cmp [&cX],17
jne @1
xor ax, ax
mov [&cX],ax
inc [cY]
cmp [cY],3
jne @1
xor ax,ax
mov [cY],ax
@1:
end;
procedure CurBk; assembler; { cursor backward w/ wrap-around }
asm
dec [&cX]
jns @1
mov ax, 16
mov [&cX],ax
dec [cY]
jns @1
mov ax, 2
mov [cY],ax
@1:
end;
procedure TTYControl( C:char );
begin
if C = 'b' then cTXT[ cY,cX ] := ' '; { erase what's under the cursor }
EraseCursor;
CASE C of
'+' : begin { new line = de< }
CurDn; ClearCursorLine; cX := 0;
end;
'-' : begin { clear and up = eu }
ClearCursorLine; CurUp;
end;
'>' : cX := 16; { end of line }
'<' : cX := 0; { carriage return }
'/' : begin { next line = d< }
CurDn; cX := 0;
end;
'\' : begin { prev line = u< }
CurUp; cX := 0;
end;
'{' : begin { reset this line = e< }
ClearCursorLine; cX := 0;
end;
'=' : begin { up and clear = ue< }
CurUp; ClearCursorLine; cX := 0;
end;
'e' : ClearCursorLine;
'u' : CurUp;
'd' : CurDn;
'l' : CurLf;
'r' : CurRt;
'h' : begin { home cursor }
cX := 0; cY := 0;
end;
'H' : begin { home cursor & clear line = he}
cX := 0; cY := 0;
ClearCursorLine;
end;
'c' : begin { clear window }
ClearCursorLine;
CurDn; ClearCursorLine;
CurDn; ClearCursorLine;
CurDn; ClearCursorLine;
cX := 0; cY := 0;
end;
'b' : CurBk;
'1' : CursorOn;
'0' : CursorOff;
{
'[' : ScrollUp;
']' : ScrollDn;
}
'E' : Qa := TRUE;
'F' : Qa := FALSE;
'P' : { pause one turn };
END;
DrawCursor;
end;
procedure DumpQueuedCh; assembler;
asm
mov si, offset QQ
mov di, offset cTXT
mov bx, Y0
mov cl, 3
@Y:
mov dx, X0
mov ch, 17
@X:
mov al, [si]
or al, al
jz @skip
dec al
cmp al,8
ja @skip2
pusha
push dx
push bx
db 0ffh, 35h { push [di] }
xor ah,ah
shl ax,2
add ax, TempCol-32
push ax
call SkyWriteCh
popa
@skip2:
mov [si], al
@skip:
inc di
inc si
add dx, 18
dec ch
jnz @X
add bx, 34
dec cl
jnz @Y
end;
procedure TTYChar( C:char );
begin
cTXT[ cY, cX ] := C;
SkyWriteCh( pX, pY, C, NormCol );
if Qa then
QQ[ cY,cX ] := 32
else
QQ[ cY,cX ] := 0;
CurFw;
DrawCursor;
end;
{ --- }
procedure Zilch;
begin
end;
procedure TheTEXT; assembler;
asm
{ "01234567890123456" }
db 0,'Q',2,0,'E', " `HEARTQUAKE'", 0,'F',0,'+'
db ' úú', 0,'+'
db ' ú=ú by ú=ú '
db 0,'Q',23, 0,'0',0,'h',0,'E'," `HEARTQUAKE' ",0,'F',0,'d',0,'d',0,'1'
db 0,'W',75, 0,'-',0,'-',0,'{'
db ' Third Place', 0,'+'
db 0,'Q',2,0,'E', " ASSEMBLY 94", 0,'F',0,'+'
db 0,'{', 'Helsinki, F'
db 0,'P',0,'u',0,'P',"'",0,'d',0,'l'
db 'inlan',0,'Q',2,0,'0','d'
db 0,'W',60, 0,'Q',3,0,'h',0,'e',0,'1'
db 'Special thanks to'
db 0,'E', ' Ryan Cramer', 0,'F',0,'+'
db 'Song now playing', 0,'\'
db 0,'E', ' Ra£l Ortega', 0,'F',0,'+'
db ' Iguanalord pic ', 0,'\'
db 0,'E', ' Tran ', 0,'F',0,'+'
db ' PMODE forever!!'
{ "01234567890123456" }
db 0,'W',10, 0,'-',0,'-',0,'{'
db 0,'c',0,'E', ' THE CREDITS ', 0,'Q',2,0,'F',0,'+'
db ' COI & Noisy-Man'
db ' Oculto & COI', 0,'>',0,'W',10
db 0,'-',0,'-',0,'{',0,'E', ' Intro', 0,'Q',2,0,'F',0,'+'
db ' JCAB', 0,'+',0,'W',10,0,'>'
db 0,'-',0,'-',0,'{',0,'E', ' Zoom/Warp', 0,'Q',2,0,'F',0,'+'
db ' JARE', 0,'+',0,'W',10,0,'>'
db 0,'-',0,'-',0,'{',0,'E', ' Screen Melt', 0,'Q',2,0,'F',0,'+'
db ' JARE', 0,'+'
db ' ARM', 0,'>',0,'W',10
db 0,'-',0,'-',0,'{',0,'E', ' Dots', 0,'Q',2,0,'F',0,'+'
db ' JCAB', 0,'+',0,'W',10,0,'>'
db 0,'-',0,'-',0,'{',0,'E', ' Screen Shatter', 0,'Q',2,0,'F',0,'+'
db ' JCAB ', 0,'+'
db ' Ra£l Ortega ', 0,'>',0,'W',10
db 0,'-',0,'-',0,'{',0,'E', ' Landscape ',24,25,26, 0,'Q',2,0,'F',0,'+'
db ' JARE', 0,'+',0,'W',10,0,'>'
db 0,'-',0,'-',0,'{',0,'E', ' Checkerboards', 0,'Q',2,0,'F',0,'+'
db ' JARE', 0,'+',0,'W',10,0,'>'
db 0,'-',0,'-',0,'{',0,'E', ' Chrome Plasma', 0,'Q',2,0,'F',0,'+'
db ' COI', 0,'+',0,'W',10,0,'>'
db 0,'-',0,'-',0,'{',0,'E', ' Rubber Poly ', 0,'Q',2,0,'F',0,'+'
db ' COI', 0,'+'
db ' ARM', 0,'>',0,'W',10
db 0,'-',0,'-',0,'{',0,'E', ' Planet', 0,'Q',2,0,'F',0,'+'
db ' JARE ', 0,'+'
db ' ARM ', 0,'>',0,'W',10
db 0,'-',0,'-',0,'{',0,'E', ' Real-time Morph', 0,'Q',2,0,'F',0,'e'
db ' JCAB', 0,'+'
db ' COI', 0,'>',0,'W',10
db 0,'-',0,'-',0,'{',0,'E', ' Waves/credits', 0,'Q',2,0,'F',0,'+'
db ' ARM ', 0,'+',0,'W',10,0,'>'
db 0,'W',10
db 0,'-',0,'-',0,'{', 'Support from:', 0,'Q',2,0,'F',0,'+'
db 'Carlos', 0,'+'
db 'Adder & Fax', 0,'>',0,'W',8
db 0,'-',0,'{', 'Axel', 0,'+'
db 'Fede, Jos, & Laz', 0,'>',0,'W',8
db 0,'-',0,'{', 'Poppy', 0,'+'
db 'A RoperoúARDY', 0,'>',0,'W',10
db 0,'c'
db 'Hope you enjoyed', 0,'+'
db 0,'Q',3, ' our demo !', 0,'+'
db 0,'W', 17, 0,'c'
db 0,'Q',2, "You've suffered a"
db 0,'Q',2,0,'E', " `Heartquake'", 0,'+'
db 0,'W', 33
db 0,'Q',3, 0,'d',0,'e',0,'u'
db ' òó 1994, Iguan', 0,'Q',2,0,'0a',0,'F'
db 0,'Q', 2, 0,'h','!'
db 0,'Q', 3, 0,'<','e!'
db 0,'Q', 4, 0,'<','ye!'
db 0,'Q', 5, 0,'<','bye!'
db 0,'Q', 6, 0,'<',' bye!'
db 0,'Q', 7, 0,'<',' bye!'
db 0,'Q', 8, 0,'<',' bye!'
db 0,'Q', 9, 0,'<',' bye!'
db 0,'Q',10, 0,'<',' bye!'
db 0,'Q',11, 0,'<',' bye!'
db 0,'Q',12, 0,'<',' bye!'
db 0,'Q',13, 0,'<',' bye!'
db 0,'Q',14, 0,'<',' bye!'
db 0,'Q',15, 0,'<',' bye!'
db 0,'Q',16, 0,'<',' bye!'
db 0,'Q',17, 0,'<',' bye!'
db 0,'Q',17, 0,'<',' bye'
db 0,'Q',17, 0,'<',' by'
db 0,'Q',17, 0,'<',' b'
db 0,'Q',17, 0,'<',' '
db 0,'Q',6,0,'r',0,'d',0,'d',0,'r',0,'E', 'òó 1994, Iguana', 0,'F'
db 0,'W',100,0,'c',0,'1'
{ "01234567890123456" }
db 'Still watching?!?'
db 'So, you want more'
db 'do you? Okay then'
db 'Here comes some '
db 'chatter for your '
db 'sole enjoyment..'
db 0,'W',5,0,'c'
db 'Jare says many of'
db 'the effects in '
db 'this demo are '
db "outdated. You've "
db 'probably already '
db 'seen them else- '
db "where, but we've "
db 'actually had them'
db 'since 1975... '
db 'just that we '
db 'never got around '
db 'to converting all'
db 'those punched '
db 'cards until now, '
db 'you know? '
db 0,'W',5,0,'c'
db 'Coding was done '
db 'on a 386/25, a '
db '486/33, and two '
db '486/66 computers.'
db 'This stuff is '
db 'about 50/50 asm &'
db 'C (as you surely '
db 'know, see is just'
db 'an assembler with'
db 'more macros), and'
db 'a pinch of TP. '
db ' '
db 'Most auxiliary '
db 'utilities,as well'
db 'as the DemoVT '
db 'music system are '
db 'coded in TP. ', 0,'e'
db 0,'W',5,0,'c'
db "Hmm... song's "
db 'still playing... '
db 'what else can I '
db 'say to fill in? '
db 'Oh, yeah, like '
db 'the neat waves & '
db 'the ñrubber" fi- '
db 'gures? Best part '
db 'of the whole demo'
db 'if I do say so '
db 'myself! (This is '
db 'modest ',0,'Q',2,0,'E','ARM',0,'Q',2,0,'F',' wri- '
db 'ting while I wait'
db "for the nice tune"
db 'to finish). '
db 0,'P',0,'P', "What's that?",0,'W',10," Ooh!"
db "It's endiing! :-("
db 0,'W',5, 'Goodbye, blue sky'
db 0,'X'
end;
const
T : byte = 0;
P : ^char = NIL;
TextTimer : longint = 0;
TextSpeed = 6; { 1/50ths of a sec per character output }
QueueTimer: longint = 0;
QueueSpeed= 3;
procedure ZeroTimer;
begin
TextTimer := VT_Timer;
QueueTimer:= VT_Timer;
end;
procedure PutText;
var C,C1 : char;
procedure Multiple;
var i,k : byte; c : char;
begin
k := byte(p^); inc( p );
for i := 1 to k do begin
c := p^; inc(p);
if c=#0 then begin
c := p^; inc(p);
TTYControl( c )
end else
TTYChar( c );
end;
end;
begin
if QueueTimer<=VT_Timer then begin
DumpQueuedCh;
inc( QueueTimer, QueueSpeed );
end;
if TextTimer > VT_Timer then Exit;
if P=NIL then P := @TheTEXT;
C := P^;
inc( P );
if C = #0 then begin
C1 := P^; inc( P );
CASE C1 OF
'X' : begin { FINISH }
dec( P,2 );
Exit;
end;
'W' : begin { WAIT n 1/10 seconds }
inc( TextTimer, 5*ord(P^) );
inc( P );
Exit;
end;
ELSE
if C1='Q' then
Multiple
else
TTYControl( C1 );
inc( TextTimer, TextSpeed );
END;
end else begin { if not #0 }
TTYChar( C );
inc( TextTimer, TextSpeed );
end;
end;
END.
