home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / TP-UTIL.ARK / FATPAD.PAS < prev    next >
Pascal/Delphi Source File  |  1986-01-06  |  12KB  |  311 lines
  1. {--------------------------}
  2. {          FATPAD          }
  3. {                          }
  4. {    By Jeff Duntemann     }
  5. {                          }
  6. {    Turbo Pascal V2.0     }
  7. {    PC DOS V2.0           }
  8. {    Last Update 12/23/84  }
  9. {--------------------------}
  10.  
  11. PROGRAM FATPAD;
  12.  
  13. { NOTE!  FATPAD REQUIRES THE MICROSOFT MOUSE AND 256K OR NO GO!!!     }
  14.  
  15. { Why limit yourself to drawing on a puny 640 X 200 screen?  FATPAD   }
  16. { sets up a "virtual pad" of double the normal hires resolution in    }
  17. { both X & Y, giving you the equivalent of four whole screens to draw }
  18. { on.  Your normal 640 X 200 screen is a "window" into the virtual    }
  19. { pad that may be "dragged" around the pad to let you view the whole  }
  20. { virtual pad, albeit one 640 X 200 screen at a time.  1280 X 400!    }
  21. { Now THAT's elbow room...                                            }
  22.  
  23. { It's not done with mirrors, but with SCRNBLT: SCReeN BLock Transfer.}
  24. { SCRNBLT moves an entire 600 X 200 screen to and from the 1280 X 400 }
  25. { virtual pad.  You start out with a blank pad.  (Keep in mind that a }
  26. { "pad" and a "screen" are two specific and distinct entities here!)  }
  27. { You draw on the screen by holding down the left mouse button and    }
  28. { moving the mouse.  You drag the window around the pad by holding    }
  29. { down the right mouse button and moving the mouse.  Before actually  }
  30. { dragging the window, SCRNBLT saves out whatever lines you have      }
  31. { drawn on the window to the pad--and then moves in a new window from }
  32. { the pad at the new X,Y.                                             }
  33.  
  34. { Press any key to exit the program.  This is strictly a demo of the  }
  35. { concept, and no facility is present to save a pad to a disk...so    }
  36. { you might not want to get TOO fancy in your artwork...              }
  37.  
  38. { If you can't get FATPAD to run, you might add some more RAM to your }
  39. { system and try again.  PAD^ is 64K in size...and RAM is cheap!      }
  40.  
  41.                             { *   *   * }
  42.  
  43. { This type definition is ahead of the constants because we are       }
  44. { using typed constants below (the mouse cursor definitions)          }
  45. { and when you use a typed constant you must define the type before   }
  46. { you define the constant.  Typed constants are a feature specific to }
  47. { Turbo Pascal and are not possible in most Pascal compilers.         }
  48.  
  49. TYPE CURSORRAY = ARRAY[0..33] OF INTEGER;
  50.  
  51. CONST GBASE = $B800;                  { Base of PC graphics RAM   }
  52.  
  53.       FRED : CURSORRAY =              { Our "mouse" cursor... }
  54.  
  55.      (8,8,                            { Fred's nose (8,8) is cursor hotspot }
  56.      $0000,       {----------------}  { Screen Mask: }
  57.      $0000,       {----------------}
  58.      $0000,       {----------------}
  59.      $0000,       {----------------}
  60.      $0000,       {----------------}
  61.      $0000,       {----------------}
  62.      $0000,       {----------------}
  63.      $0000,       {----------------}
  64.      $0000,       {----------------}
  65.      $0000,       {----------------}
  66.      $0000,       {----------------}
  67.      $0000,       {----------------}
  68.      $0000,       {----------------}
  69.      $FFFF,       {****************}
  70.      $FFFF,       {****************}
  71.      $FFFF,       {****************}
  72.  
  73.      $700E,       {-***--------***-}  { Cursor Mask: }
  74.      $F81F,       {*****------*****}
  75.      $77EE,       {-***-******-***-}
  76.      $1FF8,       {---**********---}
  77.      $318C,       {--**---**---**--}
  78.      $2C34,       {--*-**----**-*--}
  79.      $2DB4,       {--*-**-**-**-*--}
  80.      $6DB6,       {-**-**-**-**-**-}
  81.      $FE7F,       {*******--*******}
  82.      $9819,       {*--**------**--*}
  83.      $4FF2,       {-*--********--*-}
  84.      $2004,       {--*----------*--}
  85.      $1FF8,       {---**********---}
  86.      $0000,       {----------------}
  87.      $0000,       {----------------}
  88.      $0000);      {----------------}
  89.  
  90.  
  91.      DOT : CURSORRAY =                { Our dot cursor... }
  92.  
  93.      (7,4,                            { The dot's hotspot's at 7,4 }
  94.      $FFFF,       {****************}  { Screen Mask }
  95.      $FFFF,       {****************}
  96.      $FFFF,       {****************}
  97.      $F00F,       {****--------****}
  98.      $F00F,       {****--------****}
  99.      $F00F,       {****--------****}
  100.      $FFFF,       {****************}
  101.      $FFFF,       {****************}
  102.      $FFFF,       {****************}
  103.      $FFFF,       {****************}
  104.      $FFFF,       {****************}
  105.      $FFFF,       {****************}
  106.      $FFFF,       {****************}
  107.      $FFFF,       {****************}
  108.      $FFFF,       {****************}
  109.      $FFFF,       {****************}
  110.  
  111.      $0000,       {----------------}  { Cursor Mask }
  112.      $0000,       {----------------}
  113.      $0000,       {----------------}
  114.      $0000,       {----------------}
  115.      $0180,       {-------**-------}
  116.      $0000,       {----------------}
  117.      $0000,       {----------------}
  118.      $0000,       {----------------}
  119.      $0000,       {----------------}
  120.      $0000,       {----------------}
  121.      $0000,       {----------------}
  122.      $0000,       {----------------}
  123.      $0000,       {----------------}
  124.      $0000,       {----------------}
  125.      $0000,       {----------------}
  126.      $0000);      {----------------}
  127.  
  128.  
  129.  
  130.                        { REG_PACK type is used in DOS and INTR calls }
  131. TYPE REG_PACK = RECORD
  132.                   AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS : INTEGER
  133.                 END;
  134.  
  135.      GBUFF   = ARRAY[0..16191] OF BYTE;   { PC Graphics buffer }
  136.  
  137.      PADTYPE = ARRAY [0..159, 0..399] OF BYTE;  { A "fat pad;" }
  138.                                                 { 1280 X 400   }
  139.      PADPTR  = ^PADTYPE;
  140.  
  141.  
  142. VAR OLDX,OLDY,X,Y : INTEGER;     { Storage for cursor X/Y positions }
  143.     M1,M2,M3,M4   : INTEGER;     { These are the parms for mouse calls }
  144.     I,J           : INTEGER;
  145.     R             : REAL;        { For holding free space count }
  146.     REGISTERS     : REG_PACK;    { Register structure for INTR calls }
  147.  
  148.     VISIBUF       : GBUFF ABSOLUTE GBASE : $0000;  { Graphics buffer }
  149.     PAD           : PADPTR;      { Pointer to the virtual pad }
  150.     PADX,PADY     : INTEGER;     { X and Y on virtual pad }
  151.     DX            : INTEGER;     { Delta X: Change in X coordinate  }
  152.     ARTFILE       : FILE;        { Holds a 640 X 200 graphics image }
  153.  
  154.  
  155. { This is a good example of how a fairly complicated external routine }
  156. { is declared within Turbo.  See the SCRNBLT source for more info on  }
  157. { parameter passing within the assembly code itself.                  }
  158.  
  159. PROCEDURE SCRNBLT(MOVDIR,PADX,PADY : INTEGER; VAR PAD : PADTYPE );
  160. EXTERNAL 'SCRNBLT';
  161.  
  162.  
  163. {<<<PAD_CLEAR>>>}
  164.  
  165. PROCEDURE PAD_CLEAR(VAR THIS_PAD : PADTYPE);
  166.  
  167. BEGIN
  168.   FILLCHAR(THIS_PAD,SIZEOF(THIS_PAD),CHR(0))
  169. END;
  170.  
  171.  
  172.  
  173. {<<<MOUSE>>>}
  174.  
  175. PROCEDURE MOUSE(VAR M1,M2,M3,M4 : INTEGER);
  176.  
  177. VAR REGISTERS : REG_PACK;
  178.  
  179. BEGIN
  180.   WITH REGISTERS DO     { Set up AX/BX/CX/DX for interrupt }
  181.     BEGIN
  182.       AX := M1; BX := M2; CX := M3; DX := M4
  183.     END;
  184.   INTR(51,REGISTERS);   { Invoke software interrupt 51 }
  185.   WITH REGISTERS DO     { Put return values back into M1-M4 }
  186.     BEGIN
  187.       M1 := AX; M2 := BX; M3 := CX; M4 := DX
  188.     END
  189. END;
  190.  
  191.  
  192. PROCEDURE LOAD_CURSOR(CURSOR : CURSORRAY);
  193.  
  194. VAR REGISTERS : REG_PACK;
  195.     CVAR   : ARRAY[0..31] OF INTEGER;
  196.     I      : INTEGER;
  197.  
  198. BEGIN
  199.   FOR I := 0 TO 31 DO CVAR[I] := CURSOR[I+2];   { Copy cursor }
  200.   WITH REGISTERS DO
  201.     BEGIN
  202.       AX := 9;
  203.       BX := CURSOR[0];    { Hotspot X }
  204.       CX := CURSOR[1];    { Hotspot Y }
  205.       DX := OFS(CVAR);    { Offset of cursor array  }
  206.       ES := SEG(CVAR);    { Segment of cursor array }
  207.     END;
  208.   INTR(51,REGISTERS)      { Invoke mouse interrupt 51 }
  209. END;
  210.  
  211.  
  212. PROCEDURE SHOW_CURSOR;
  213.  
  214. BEGIN
  215.   M1 := 1; MOUSE(M1,M2,M3,M4)  { Turn mouse cursor on }
  216. END;
  217.  
  218.  
  219. PROCEDURE HIDE_CURSOR;
  220.  
  221. BEGIN
  222.   M1 := 2; MOUSE(M1,M2,M3,M4)  { Turn mouse cursor off }
  223. END;
  224.  
  225.  
  226. PROCEDURE INIT_MOUSE;
  227.  
  228. BEGIN
  229.   M1 := 0; MOUSE(M1,M2,M3,M4)
  230. END;
  231.  
  232.  
  233.  
  234. BEGIN      { FATPAD MAIN }
  235.   HIRES;                          { Choose graphics mode & color }
  236.   HIRESCOLOR(YELLOW);
  237.   R := MEMAVAIL;                  { MEMAVAIL returns a negative qty }
  238.   IF R < 0 THEN R := R + 65536.0; { for paragraphs over MAXINT      }
  239.   IF R < 16384.0 THEN
  240.     BEGIN
  241.       WRITELN('>>Sorry, but you don''t have enough memory to run FATPAD.');
  242.       WRITELN('  Generally, 256K is the minimum amount required, but that');
  243.       WRITELN('  may be affected by how many DOS extensions and device');
  244.       WRITELN('  drivers are resident in your system.  64K of RAM is needed');
  245.       WRITELN('  by the fat pad buffer itself.  Returning to DOS...');
  246.       HALT
  247.     END;
  248.   NEW(PAD);                       { Create the fat pad }
  249.   ASSIGN(ARTFILE,'SNAPSHOT.PIC'); { Load in a sample picture to show   }
  250.   RESET(ARTFILE);                 { how inadequite 640 X 200 is...     }
  251.   BLOCKREAD(ARTFILE,VISIBUF,128);
  252.   CLOSE(ARTFILE);
  253.   INIT_MOUSE;                     { Init mouse driver via mouse call 0 }
  254.   LOAD_CURSOR(DOT);               { Pour dot cursor into mouse cursor block  }
  255.   SHOW_CURSOR;                    { Turn mouse cursor on }
  256.  
  257.   M1 := 3; PADX := 0; PADY :=0; OLDX := 0; OLDY := 0;  { Init variables }
  258.   PAD_CLEAR(PAD^);                                     { & clear pad    }
  259.  
  260.   WHILE NOT KEYPRESSED DO         { Exit FATPAD when any key pressed }
  261.     BEGIN
  262.       M1 := 3; MOUSE(M1,M2,M3,M4);     { Poll mouse position and buttons }
  263.       IF (M2 AND 1) <> 0 THEN          { Left button draws }
  264.         BEGIN
  265.           HIDE_CURSOR;                 { Hide mouse cursor before draw   }
  266.           DRAW(OLDX,OLDY,M3,M4,1);     { Draw line between old X,Y }
  267.           SHOW_CURSOR;                 { and new X,Y }
  268.           M1:=3;
  269.           OLDX := M3;                  { Update old X & Y }
  270.           OLDY := M4;
  271.         END
  272.       ELSE IF (M2 AND 2) <> 0 THEN     { Right button drags }
  273.         BEGIN
  274.           LOAD_CURSOR(FRED);
  275.           DX := M3-OLDX;               { Calc delta-X }
  276.  
  277.                            { Now...we drag ONLY if Y has changed OR }
  278.                            { if X has changed by more than 16 bits: }
  279.           IF (ABS(DX) >= 16) OR (OLDY <> M4) THEN
  280.             BEGIN
  281.               HIDE_CURSOR;        { Hide mouse cursor before saving }
  282.                                   { screen to the virtual pad       }
  283.               SCRNBLT(0,PADX,PADY,PAD^);      { save out screen at  }
  284.                                               { PADX,PADY to PAD    }
  285.               PADY := PADY - (M4-OLDY);       { Apply deltas to new }
  286.               PADX := PADX - (M3-OLDX);       { pad positions       }
  287.  
  288.               IF PADY < 0   THEN PADY := 0;   { limit drag ranges    }
  289.               IF PADY > 200 THEN PADY := 200; { to meaningful values }
  290.               IF PADX < 0   THEN PADX := 0;
  291.               IF PADX > 640 THEN PADX := 640;
  292.  
  293.               SCRNBLT(1,PADX,PADY,PAD^);      { "bring back" window's }
  294.                                               { worth of graphics from}
  295.                                               { new PADX,PADY in PAD  }
  296.               SHOW_CURSOR;           { It's now safe to reshow cursor }
  297.               M1 := 3;
  298.               OLDX := M3;            { Update old X/Y values }
  299.               OLDY := M4;
  300.             END;
  301.         LOAD_CURSOR(DOT)             { BLT's over; bring back dot cursor }
  302.       END
  303.     ELSE
  304.       BEGIN
  305.         OLDX := M3;   { Must update old X,Y even if nothing is done }
  306.         OLDY := M4;
  307.         END;
  308.       END;  { WHILE }
  309.   TEXTMODE
  310. END.
  311.