home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
MADTRB21.ZIP
/
FATPAD.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-06-06
|
12KB
|
311 lines
{--------------------------}
{ FATPAD }
{ }
{ By Jeff Duntemann }
{ }
{ Turbo Pascal V2.0 }
{ PC DOS V2.0 }
{ Last Update 12/23/84 }
{--------------------------}
PROGRAM FATPAD;
{ NOTE! FATPAD REQUIRES THE MICROSOFT MOUSE AND 256K OR NO GO!!! }
{ Why limit yourself to drawing on a puny 640 X 200 screen? FATPAD }
{ sets up a "virtual pad" of double the normal hires resolution in }
{ both X & Y, giving you the equivalent of four whole screens to draw }
{ on. Your normal 640 X 200 screen is a "window" into the virtual }
{ pad that may be "dragged" around the pad to let you view the whole }
{ virtual pad, albeit one 640 X 200 screen at a time. 1280 X 400! }
{ Now THAT's elbow room... }
{ It's not done with mirrors, but with SCRNBLT: SCReeN BLock Transfer.}
{ SCRNBLT moves an entire 600 X 200 screen to and from the 1280 X 400 }
{ virtual pad. You start out with a blank pad. (Keep in mind that a }
{ "pad" and a "screen" are two specific and distinct entities here!) }
{ You draw on the screen by holding down the left mouse button and }
{ moving the mouse. You drag the window around the pad by holding }
{ down the right mouse button and moving the mouse. Before actually }
{ dragging the window, SCRNBLT saves out whatever lines you have }
{ drawn on the window to the pad--and then moves in a new window from }
{ the pad at the new X,Y. }
{ Press any key to exit the program. This is strictly a demo of the }
{ concept, and no facility is present to save a pad to a disk...so }
{ you might not want to get TOO fancy in your artwork... }
{ If you can't get FATPAD to run, you might add some more RAM to your }
{ system and try again. PAD^ is 64K in size...and RAM is cheap! }
{ * * * }
{ This type definition is ahead of the constants because we are }
{ using typed constants below (the mouse cursor definitions) }
{ and when you use a typed constant you must define the type before }
{ you define the constant. Typed constants are a feature specific to }
{ Turbo Pascal and are not possible in most Pascal compilers. }
TYPE CURSORRAY = ARRAY[0..33] OF INTEGER;
CONST GBASE = $B800; { Base of PC graphics RAM }
FRED : CURSORRAY = { Our "mouse" cursor... }
(8,8, { Fred's nose (8,8) is cursor hotspot }
$0000, {----------------} { Screen Mask: }
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$FFFF, {****************}
$FFFF, {****************}
$FFFF, {****************}
$700E, {-***--------***-} { Cursor Mask: }
$F81F, {*****------*****}
$77EE, {-***-******-***-}
$1FF8, {---**********---}
$318C, {--**---**---**--}
$2C34, {--*-**----**-*--}
$2DB4, {--*-**-**-**-*--}
$6DB6, {-**-**-**-**-**-}
$FE7F, {*******--*******}
$9819, {*--**------**--*}
$4FF2, {-*--********--*-}
$2004, {--*----------*--}
$1FF8, {---**********---}
$0000, {----------------}
$0000, {----------------}
$0000); {----------------}
DOT : CURSORRAY = { Our dot cursor... }
(7,4, { The dot's hotspot's at 7,4 }
$FFFF, {****************} { Screen Mask }
$FFFF, {****************}
$FFFF, {****************}
$F00F, {****--------****}
$F00F, {****--------****}
$F00F, {****--------****}
$FFFF, {****************}
$FFFF, {****************}
$FFFF, {****************}
$FFFF, {****************}
$FFFF, {****************}
$FFFF, {****************}
$FFFF, {****************}
$FFFF, {****************}
$FFFF, {****************}
$FFFF, {****************}
$0000, {----------------} { Cursor Mask }
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0180, {-------**-------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000, {----------------}
$0000); {----------------}
{ REG_PACK type is used in DOS and INTR calls }
TYPE REG_PACK = RECORD
AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS : INTEGER
END;
GBUFF = ARRAY[0..16191] OF BYTE; { PC Graphics buffer }
PADTYPE = ARRAY [0..159, 0..399] OF BYTE; { A "fat pad;" }
{ 1280 X 400 }
PADPTR = ^PADTYPE;
VAR OLDX,OLDY,X,Y : INTEGER; { Storage for cursor X/Y positions }
M1,M2,M3,M4 : INTEGER; { These are the parms for mouse calls }
I,J : INTEGER;
R : REAL; { For holding free space count }
REGISTERS : REG_PACK; { Register structure for INTR calls }
VISIBUF : GBUFF ABSOLUTE GBASE : $0000; { Graphics buffer }
PAD : PADPTR; { Pointer to the virtual pad }
PADX,PADY : INTEGER; { X and Y on virtual pad }
DX : INTEGER; { Delta X: Change in X coordinate }
ARTFILE : FILE; { Holds a 640 X 200 graphics image }
{ This is a good example of how a fairly complicated external routine }
{ is declared within Turbo. See the SCRNBLT source for more info on }
{ parameter passing within the assembly code itself. }
PROCEDURE SCRNBLT(MOVDIR,PADX,PADY : INTEGER; VAR PAD : PADTYPE );
EXTERNAL 'SCRNBLT';
{<<<PAD_CLEAR>>>}
PROCEDURE PAD_CLEAR(VAR THIS_PAD : PADTYPE);
BEGIN
FILLCHAR(THIS_PAD,SIZEOF(THIS_PAD),CHR(0))
END;
{<<<MOUSE>>>}
PROCEDURE MOUSE(VAR M1,M2,M3,M4 : INTEGER);
VAR REGISTERS : REG_PACK;
BEGIN
WITH REGISTERS DO { Set up AX/BX/CX/DX for interrupt }
BEGIN
AX := M1; BX := M2; CX := M3; DX := M4
END;
INTR(51,REGISTERS); { Invoke software interrupt 51 }
WITH REGISTERS DO { Put return values back into M1-M4 }
BEGIN
M1 := AX; M2 := BX; M3 := CX; M4 := DX
END
END;
PROCEDURE LOAD_CURSOR(CURSOR : CURSORRAY);
VAR REGISTERS : REG_PACK;
CVAR : ARRAY[0..31] OF INTEGER;
I : INTEGER;
BEGIN
FOR I := 0 TO 31 DO CVAR[I] := CURSOR[I+2]; { Copy cursor }
WITH REGISTERS DO
BEGIN
AX := 9;
BX := CURSOR[0]; { Hotspot X }
CX := CURSOR[1]; { Hotspot Y }
DX := OFS(CVAR); { Offset of cursor array }
ES := SEG(CVAR); { Segment of cursor array }
END;
INTR(51,REGISTERS) { Invoke mouse interrupt 51 }
END;
PROCEDURE SHOW_CURSOR;
BEGIN
M1 := 1; MOUSE(M1,M2,M3,M4) { Turn mouse cursor on }
END;
PROCEDURE HIDE_CURSOR;
BEGIN
M1 := 2; MOUSE(M1,M2,M3,M4) { Turn mouse cursor off }
END;
PROCEDURE INIT_MOUSE;
BEGIN
M1 := 0; MOUSE(M1,M2,M3,M4)
END;
BEGIN { FATPAD MAIN }
HIRES; { Choose graphics mode & color }
HIRESCOLOR(YELLOW);
R := MEMAVAIL; { MEMAVAIL returns a negative qty }
IF R < 0 THEN R := R + 65536.0; { for paragraphs over MAXINT }
IF R < 16384.0 THEN
BEGIN
WRITELN('>>Sorry, but you don''t have enough memory to run FATPAD.');
WRITELN(' Generally, 256K is the minimum amount required, but that');
WRITELN(' may be affected by how many DOS extensions and device');
WRITELN(' drivers are resident in your system. 64K of RAM is needed');
WRITELN(' by the fat pad buffer itself. Returning to DOS...');
HALT
END;
NEW(PAD); { Create the fat pad }
ASSIGN(ARTFILE,'SNAPSHOT.PIC'); { Load in a sample picture to show }
RESET(ARTFILE); { how inadequite 640 X 200 is... }
BLOCKREAD(ARTFILE,VISIBUF,128);
CLOSE(ARTFILE);
INIT_MOUSE; { Init mouse driver via mouse call 0 }
LOAD_CURSOR(DOT); { Pour dot cursor into mouse cursor block }
SHOW_CURSOR; { Turn mouse cursor on }
M1 := 3; PADX := 0; PADY :=0; OLDX := 0; OLDY := 0; { Init variables }
PAD_CLEAR(PAD^); { & clear pad }
WHILE NOT KEYPRESSED DO { Exit FATPAD when any key pressed }
BEGIN
M1 := 3; MOUSE(M1,M2,M3,M4); { Poll mouse position and buttons }
IF (M2 AND 1) <> 0 THEN { Left button draws }
BEGIN
HIDE_CURSOR; { Hide mouse cursor before draw }
DRAW(OLDX,OLDY,M3,M4,1); { Draw line between old X,Y }
SHOW_CURSOR; { and new X,Y }
M1:=3;
OLDX := M3; { Update old X & Y }
OLDY := M4;
END
ELSE IF (M2 AND 2) <> 0 THEN { Right button drags }
BEGIN
LOAD_CURSOR(FRED);
DX := M3-OLDX; { Calc delta-X }
{ Now...we drag ONLY if Y has changed OR }
{ if X has changed by more than 16 bits: }
IF (ABS(DX) >= 16) OR (OLDY <> M4) THEN
BEGIN
HIDE_CURSOR; { Hide mouse cursor before saving }
{ screen to the virtual pad }
SCRNBLT(0,PADX,PADY,PAD^); { save out screen at }
{ PADX,PADY to PAD }
PADY := PADY - (M4-OLDY); { Apply deltas to new }
PADX := PADX - (M3-OLDX); { pad positions }
IF PADY < 0 THEN PADY := 0; { limit drag ranges }
IF PADY > 200 THEN PADY := 200; { to meaningful values }
IF PADX < 0 THEN PADX := 0;
IF PADX > 640 THEN PADX := 640;
SCRNBLT(1,PADX,PADY,PAD^); { "bring back" window's }
{ worth of graphics from}
{ new PADX,PADY in PAD }
SHOW_CURSOR; { It's now safe to reshow cursor }
M1 := 3;
OLDX := M3; { Update old X/Y values }
OLDY := M4;
END;
LOAD_CURSOR(DOT) { BLT's over; bring back dot cursor }
END
ELSE
BEGIN
OLDX := M3; { Must update old X,Y even if nothing is done }
OLDY := M4;
END;
END; { WHILE }
TEXTMODE
END.