home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Fred Fish Collection 1.5
/
ffcollection-1-5-1992-11.iso
/
ff_disks
/
300-399
/
ff338.lzh
/
SASTools
/
WBruise
/
WBruise.mod
< prev
next >
Wrap
Text File
|
1990-03-23
|
3KB
|
77 lines
(***************************************************************************
* Programme : WBruise.mod *
* Usage : WBruise *
* Version : V1.31 *
* Date : 15.05.1989 *
* Author : Jörg Sixt *
* Purpose : your Blitter dies with laughter *
* Language : Modula-2,AMSoft PD-Version from Fish 113 *
* Bugs : *
***************************************************************************)
MODULE WBruise ;
FROM SYSTEM IMPORT ADR ;
FROM Hardtricks IMPORT leftMouseButton ;
FROM Intuition IMPORT OpenScreen,CloseScreen,NewScreen,ScreenPtr,IntuitionBase,
OpenIntuition,ScreenToFront ;
FROM Graphics IMPORT BltBitMap,SetRast ;
CONST CUTS = 10 ;
VAR NewScr : NewScreen ;
MakePtr,
ShowPtr,
HelpPtr,
WBScr : ScreenPtr ;
IBase : POINTER TO IntuitionBase ;
i : INTEGER ;
PROCEDURE Frames ;
VAR j,
yOffset : INTEGER ;
planes : LONGINT ;
BEGIN
yOffset := (WBScr^.height*(CUTS-i)) DIV (2*CUTS) ;
SetRast(ADR(MakePtr^.rastPort),0) ;
FOR j := 0 TO WBScr^.height BY CUTS DO
planes := BltBitMap ( WBScr^.rastPort.bitMap,0,j,
MakePtr^.rastPort.bitMap,0,yOffset,
MakePtr^.width,i,0C0H,0FFH,00H) ;
yOffset := yOffset+i ;
END ;
ScreenToFront(MakePtr) ;
HelpPtr := ShowPtr ;
ShowPtr := MakePtr ;
MakePtr := HelpPtr ;
END Frames ;
BEGIN
IBase := OpenIntuition() ;
WBScr := IBase^.activeScreen ;
WITH NewScr DO
topEdge := WBScr^.topEdge ;
width := WBScr^.width ;
height := WBScr^.height ;
depth := WBScr^.bitMap.depth ;
viewModes := WBScr^.viewPort.modes ;
type := WBScr^.flags ;
END ;
ShowPtr := OpenScreen(NewScr) ;
IF (ShowPtr = NIL) THEN HALT ; END ;
MakePtr := OpenScreen(NewScr) ;
IF (ShowPtr = NIL) THEN CloseScreen(ShowPtr) ; HALT ; END ;
WHILE NOT(leftMouseButton()) DO
ScreenToFront (WBScr) ;
FOR i := CUTS-1 TO 1 BY -1 DO Frames ; END ;
FOR i := 1 TO CUTS-1 DO Frames ; END ;
END ;
CloseScreen(MakePtr) ;
CloseScreen(ShowPtr) ;
END WBruise.