home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TEGL6B.ZIP / INTROPAK.EXE / PCXDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-06-10  |  10.1 KB  |  447 lines
  1. {-----------------------------------------------------------------------------}
  2. {               TEGL Windows ToolKit II                  }
  3. {          Copyright (C) 1990, 1991 TEGL Systems Corporation              }
  4. {                All Rights Reserved.                  }
  5. {-----------------------------------------------------------------------------}
  6.  
  7.  
  8. {$M 20000,0,655360}
  9.        {-- Defaults }
  10. {$A-}  {-- A- byte alignment }
  11. {$B-}  {-- B- short circuit boolean evaluation }
  12. {$D+}  {-- D- No debug info }
  13. {$E-}  {-- E- No emulation }
  14. {$F-}  {-- F- Far calls only when necessary }
  15. {$I-}  {-- I- I/O error checking done internally }
  16. {$L+}  {-- L- No local symbols }
  17. {$N-}  {-- N- Software reals }
  18. {$R-}  {-- R- Range checking off }
  19. {$S-}  {-- S- Stack overflow off }
  20. {$V-}  {-- V- No strict type checking }
  21.  
  22. USES
  23.   crt,
  24.   errorlog,
  25.   ipstacks,
  26.   teglfont,
  27.   pcxgraph,
  28.   soundunt,
  29.   virtmem,
  30.   videochk,
  31.   teglmain,
  32.   tgi,
  33.   tgraph,
  34.   teglintr,
  35.   teglunit,
  36.   fastgrph;
  37.  
  38. const
  39. {$I pcxdemo.inc}
  40.  
  41. var  ix1,iy1,ix2,iy2,bt : integer;
  42.  
  43. {$F+}
  44. Procedure lipspcxproc; External;
  45. {$L lips2.obj}
  46. {$F-}
  47.  
  48. function UserPressingButton(fs:ImageStkPtr; ms:MsClickPtr) : Boolean;
  49.    var mxpos,mypos : Word;
  50.        stat       : Word;
  51.        ms1       : MsClickPtr;
  52.    begin
  53.       stat := MousePosition(mxpos,mypos);
  54.  
  55.       IF FunctionKeyCode=0 THEN
  56.      ms1  := CheckMouseClickPos(fs,mxpos,mypos)
  57.       ELSE
  58.      BEGIN
  59.         stat := Ord(ScanCodeTable[lo(FunctionKeyCode)]);
  60.         ms1  := ms;
  61.      END;
  62.  
  63.       UserPressingButton := (ms1=ms) and (stat<>0);
  64.    end;
  65.  
  66.  
  67.  
  68. {$F+}
  69. Function ViewSecondScreen(ifs:ImageStkPtr; ms: MsClickPtr) : Word;
  70. {$F-}
  71.    VAR
  72.       ax,ay,ax1,ay1  : Integer;
  73.    BEGIN
  74.       HideMouse;
  75.  
  76.       ax  := ms^.ms.x and $fff8;
  77.       ay  := ms^.ms.y;
  78.       ax1 := ax + (ms^.ms.x1-ms^.ms.x);
  79.       ay1 := ms^.ms.y1;
  80.  
  81.       MoveStackImage(ifs,ax,ay);
  82.  
  83.       ShowMouse;
  84.       viewsecondscreen := 1;
  85.    END;
  86.  
  87.  
  88. {$F+}
  89. Function BounceDemo(ifs:ImageStkPtr; ms: MsClickPtr) : Word;
  90. {$F-}
  91.    var i,j     : integer;
  92.        d,e,r   : boolean;
  93.        ch      : char;
  94.        x,y,ct  : integer;
  95.    begin
  96.       if visualsquarebuttonpress(ifs,ms) then
  97.      begin
  98.         hidemouse;
  99.         x := ifs^.x+16;
  100.         y := ifs^.y+16;
  101.  
  102.         ix1 := ix1 and $fff8;
  103.         ix2 := ix1 + 368;
  104.  
  105.         while keypressed do ch := readkey;
  106.  
  107.         d := true;
  108.         e := true;
  109.         r := true;
  110.         ct := 1;
  111.         repeat
  112.            if d then
  113.           begin
  114.              while (iy2<338) and not keypressed and (mouse_buttons=0) do
  115.             begin
  116.                movevideopixels(ix1,iy1,ix2,iy2,x,y,0,0,ptr($a000,$9600),ptr($a000,$0000));
  117.         {       movevideopixels(ix1,iy1,ix2,iy2,x,y,0,0,$8000,0); }
  118.                inc(iy1,ct);
  119.                inc(iy2,ct);
  120.             end;
  121.  
  122.              if iy2>338 then
  123.             begin
  124.                dec(iy1,ct);
  125.                dec(iy2,ct);
  126.             end;
  127.           end
  128.            else
  129.           begin
  130.              while (iy1>0) and not keypressed and (mouse_buttons=0) do
  131.             begin
  132.                movevideopixels(ix1,iy1,ix2,iy2,x,y,0,0,ptr($a000,$9600),ptr($a000,$0000));
  133.     {           movevideopixels(ix1,iy1,ix2,iy2,x,y,0,0,$8000,0); }
  134.                dec(iy1,ct);
  135.                dec(iy2,ct);
  136.             end;
  137.  
  138.              if iy1<0 then
  139.             begin
  140.                inc(iy1,ct);
  141.                inc(iy2,ct);
  142.             end;
  143.           end;
  144.  
  145.            d := not d;
  146.  
  147.            if e then
  148.           begin
  149.              inc(ix1,8);
  150.              inc(ix2,8);
  151.           end
  152.            else
  153.           begin
  154.              dec(ix1,8);
  155.              dec(ix2,8);
  156.           end;
  157.  
  158.            if ix2>639 then
  159.           begin
  160.              dec(ix1,8);
  161.              dec(ix2,8);
  162.              e := not e;
  163.           end
  164.            else
  165.            if ix1<0 then
  166.           begin
  167.              inc(ix1,8);
  168.              inc(ix2,8);
  169.              e := not e;
  170.           end;
  171.  
  172.            if r then
  173.           begin
  174.             inc(ct);
  175.             if ct>10 then
  176.                r := not r;
  177.           end
  178.            else
  179.           begin
  180.              dec(ct);
  181.              if ct=1 then
  182.             r := not r;
  183.           end;
  184.         until keypressed or (mouse_buttons<>0);
  185.  
  186.         showmouse;
  187.         while keypressed do ch := readkey;
  188.         while (mouse_buttons<>0) do;
  189.  
  190.         ReleaseSquareButton(ifs,ms);
  191.      end;
  192.  
  193.       BounceDemo := 1;
  194.    END;
  195.  
  196.  
  197. {$F+}
  198. Function ShiftVert(ifs:ImageStkPtr; ms: MsClickPtr) : Word;
  199. {$F-}
  200.    var x,y,x1,y1 : integer;
  201.    begin
  202.       PressSquareButton(ifs,ms);
  203.  
  204.       x  := ifs^.x+16;
  205.       y  := ifs^.y+16;
  206.       x1 := x+368+16;
  207.       y1 := y+168+16;
  208.  
  209.       prepareforpartialupdate(ifs,x,y,x1,y1);
  210.       repeat
  211.      case ms^.clicknumber of
  212. {/\}         7 : begin
  213. {/\}            dec(iy1,8);
  214.             dec(iy2,8);
  215.          end;
  216. {/\}         8 : begin
  217.             dec(iy1);
  218.             dec(iy2);
  219.          end;
  220. {\/}         9 : begin
  221.             inc(iy1);
  222.             inc(iy2);
  223.          end;
  224. {\/}        10 : begin
  225. {\/}            inc(iy1,8);
  226.             inc(iy2,8);
  227.          end;
  228.      end;
  229.  
  230.      if iy1<0 then
  231.         begin
  232.            iy1 := 0;
  233.            iy2 := 168;
  234.         end
  235.      else
  236.      if iy2>338 then
  237.         begin
  238.            iy1 := 338-(iy2-iy1);
  239.            iy2 := 338;
  240.         end;
  241.  
  242.      movevideopixels(ix1,iy1,ix2,iy2,x,y,0,0,ptr($a000,$9600),ptr($a000,$0000))
  243.  
  244.       until not userpressingbutton(ifs,ms);
  245.       commitupdate;
  246.       ReleaseSquareButton(ifs,ms);
  247.  
  248.       shiftvert := 1;
  249.    end;
  250.  
  251.  
  252. {$F+}
  253. Function ScrollHorz(ifs:ImageStkPtr; ms: MsClickPtr) : Word;
  254. {$F-}
  255.    var x,y,x1,y1 : integer;
  256.    begin
  257.       PressSquareButton(ifs,ms);
  258.  
  259.       x  := ifs^.x+16;
  260.       y  := ifs^.y+16;
  261.       x1 := x+368;
  262.       y1 := y+168;
  263.  
  264.       prepareforpartialupdate(ifs,x,y,x1,y1);
  265.       repeat
  266.      case ms^.clicknumber of
  267. {.<}        11 : movevideopixels(x,y,x1,y1,x,y,0,8,ptr($a000,$0000),ptr($a000,$0000));
  268. {.>}        13 : movevideopixels(x,y,x1,y1,x,y,0,-8,ptr($a000,$0000),ptr($a000,$0000));
  269.      end;
  270.       until not userpressingbutton(ifs,ms);
  271.       commitupdate;
  272.       ReleaseSquareButton(ifs,ms);
  273.  
  274.       scrollhorz := 1;
  275.    end;
  276.  
  277. {$F+}
  278. Function ScrollVert(ifs:ImageStkPtr; ms: MsClickPtr) : Word;
  279. {$F-}
  280.    var x,y,x1,y1 : integer;
  281.    begin
  282.       PressSquareButton(ifs,ms);
  283.  
  284.       x  := ifs^.x+16;
  285.       y  := ifs^.y+16;
  286.       x1 := x+368;
  287.       y1 := y+168;
  288.  
  289.       prepareforpartialupdate(ifs,x,y,x1,y1);
  290.       repeat
  291.      case ms^.clicknumber of
  292. {.^}        12 : movevideopixels(x,y,x1,y1,x,y,-8,0,ptr($a000,$0000),ptr($a000,$0000));
  293. {.v}        14 : movevideopixels(x,y,x1,y1,x,y,8,0,ptr($a000,$0000),ptr($a000,$0000));
  294.      end;
  295.       until not userpressingbutton(ifs,ms);
  296.       commitupdate;
  297.       ReleaseSquareButton(ifs,ms);
  298.  
  299.       scrollvert := 1;
  300.    end;
  301.  
  302.  
  303. {$F+}
  304. Function ShiftHorz(ifs:ImageStkPtr; ms: MsClickPtr) : Word;
  305. {$F-}
  306.    var x,y,x1,y1 : integer;
  307.    begin
  308.       PressSquareButton(ifs,ms);
  309.  
  310.       x  := ifs^.x+16;
  311.       y  := ifs^.y+16;
  312.       x1 := x+368;
  313.       y1 := y+168;
  314.  
  315.       prepareforpartialupdate(ifs,x,y,x1,y1);
  316.       repeat
  317.      case ms^.clicknumber of
  318. {<<}         3 : begin
  319.             dec(ix1,8);
  320.             dec(ix2,8);
  321.             ix2 := ix2 - (ix1 and 7);
  322.             ix1 := ix1 and $fff8;
  323.          end;
  324. {<}         4 : begin
  325.             dec(ix1);
  326.             dec(ix2);
  327.          end;
  328. {>}         5 : begin
  329.             inc(ix1);
  330.             inc(ix2);
  331.          end;
  332. {>>}         6 : begin
  333.             inc(ix1,8);
  334.             inc(ix2,8);
  335.             ix2 := ix2 - (ix1 and 7);
  336.             ix1 := ix1 and $fff8;
  337.          end;
  338.      end;
  339.  
  340.      if ix1<0 then
  341.         begin
  342.            ix1 := 0;
  343.            ix2 := 368;
  344.         end
  345.      else
  346.      if ix2>639 then
  347.         begin
  348.            ix1 := 639-(ix2-ix1);
  349.            ix2 := 639;
  350.         end;
  351.  
  352.      movevideopixels(ix1,iy1,ix2,iy2,x,y,0,0,ptr($a000,$9600),ptr($a000,$0000));
  353.  
  354.       until not userpressingbutton(ifs,ms);
  355.       commitupdate;
  356.       ReleaseSquareButton(ifs,ms);
  357.  
  358.       shifthorz := 1;
  359.    end;
  360.  
  361.  
  362. {$F+}
  363. Function SquareButtonTest(ifs:ImageStkPtr; ms: MsClickPtr) : Word;
  364. {$F-}
  365.    begin
  366.       if visualsquarebuttonpress(ifs,ms) then
  367.      begin
  368.         ReleaseSquareButton(ifs,ms);
  369.      end;
  370.       squarebuttonTest := 0;
  371.    end;
  372.  
  373. {$F+}
  374. Function ExitOption(ifs:ImageStkPtr; ms: MsClickPtr) : Word;
  375. {$F-}
  376.    BEGIN
  377.       if visualsquarebuttonpress(ifs,ms) then
  378.      Abortexit('TEGL PCX Graphics DEMO');
  379.       exitoption := 1;
  380.    END;
  381.  
  382. BEGIN
  383.    maxwindowsize := 128000;
  384.    IF RegisterTGIDriver(@_grevga16_driver)=0 THEN;
  385.    SetStandardHeapSize(64000); {Reserve about 32k for Video Drivers}
  386.    setvideochoices(TG_CGA,FALSE);
  387.    setvideochoices(TG_HGC,FALSE);
  388.    TEGLInit(videoautodetect,20480);
  389.  
  390.    SetPCXBWMap($ff,$ff,$00,$ff);
  391.    QuickShowPCXFile('TEGLLOGO.pcx',true,0,getmaxy,getmaxx);
  392.    IPpushimage(0,0,319,239);
  393.  
  394.    if getmaxy>400 then
  395.       begin
  396.      IPputimage(320,0,ipstack,FGNORM);
  397.      IPPutimage(0,240,ipstack,FGNORM);
  398.      IPSetCoord(ipstack,320,240,639,479);
  399.       end
  400.    else
  401.       IPSetCoord(ipstack,320,108,639,347);
  402.    ippopimage;
  403.  
  404.    SetPCXBWMap($ff,$ff,$ff,$ff);
  405.  
  406.    {there are only 27k bytes left on the second portion of the VGA}
  407.    {thus you can get only about 338 lines.}
  408.    DisplayPCXFile(@lipspcxproc,true,$9600,338,getmaxx);
  409.  
  410.  
  411.    pushimage(80,100,480,325);
  412.    bevelboxfs(stackptr,0,0,400,225,white,lightgray,lightgray,8);
  413.    bevelboxfs(stackptr,8,8,392,192,lightgray,white,lightgray,7);
  414.    SetMoveFrameCallProc(StackPtr,viewsecondscreen);
  415.    movevideopixels(96,96,464,264,96,116,0,0,ptr($a000,$9600),ptr($a000,$0000));
  416.  
  417.    ix1 := 96;
  418.    iy1 := 96;
  419.    ix2 := 464;
  420.    iy2 := 264;
  421.  
  422.  
  423.    DefineSquareButtonText(stackptr,8,192,57,217,10,4,'QUIT',exitoption);
  424.    DefineSquareButtonText(stackptr,57,192,110,217,12,4,'DEMO',bouncedemo);
  425.  
  426.    DefineSquareButtonClick(stackptr,110,192,140,217,4,7,@imageshftll,shifthorz);
  427.    DefineSquareButtonClick(stackptr,140,192,170,217,4,7,@imageshftl,shifthorz);
  428.    DefineSquareButtonClick(stackptr,170,192,200,217,4,7,@imageshftr,shifthorz);
  429.    DefineSquareButtonClick(stackptr,200,192,230,217,4,7,@imageshftrr,shifthorz);
  430.  
  431.    DefineSquareButtonClick(stackptr,230,192,260,217,4,7,@imageshftuu,shiftvert);
  432.    DefineSquareButtonClick(stackptr,260,192,290,217,4,7,@imageshftu,shiftvert);
  433.    DefineSquareButtonClick(stackptr,290,192,320,217,4,7,@imageshftd,shiftvert);
  434.    DefineSquareButtonClick(stackptr,320,192,350,217,4,7,@imageshftdd,shiftvert);
  435.    setpalette(8,8);
  436.  
  437.    DefineSquareButtonClick(stackptr,350,192,371,205,7,3,@imagetshftl,scrollhorz);
  438.    DefineSquareButtonClick(stackptr,350,205,371,217,7,3,@imagetshftu,scrollvert);
  439.  
  440.    DefineSquareButtonClick(stackptr,371,192,392,205,7,3,@imagetshftr,scrollhorz);
  441.    DefineSquareButtonClick(stackptr,371,205,392,217,7,3,@imagetshftd,scrollvert);
  442.  
  443.    SetCtrlBreakFS(ExitOption);
  444.  
  445.    TEGLSupervisor;
  446. END.
  447.