Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MADTRB21.ZIP/FATPAD.PAS

Pascal/Delphi Source File | 1985-06-06 | 11.5 KB | 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.