home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_progs / prog_oth / m2amiga.lzh / M2AMIGA / DEMOS / TILT.MOD < prev   
Encoding:
Text File  |  1991-08-16  |  3.0 KB  |  105 lines
  1. MODULE tilt;
  2. (*
  3.  * original source Leo L. Schwab, thanx for all these screen hacks
  4.  * adapted to M2Amiga 16.9.87/ms
  5.  *)
  6. FROM SYSTEM IMPORT
  7.  ADDRESS,ADR,SETREG,SHIFT;
  8. FROM Arts IMPORT
  9.  Assert,TermProcedure;
  10. FROM Dos IMPORT
  11.  Delay;
  12. FROM Graphics IMPORT
  13.  BitMapPtr,RastPortPtr,ViewModes,ViewModeSet,
  14.  BltBitMap,ScrollRaster;
  15. FROM Intuition IMPORT
  16.  recoveryAlert,IDCMPFlagSet,NewWindow,NewScreen,ScreenFlags,ScreenFlagSet,
  17.  ScreenPtr,WindowFlags,WindowFlagSet,WindowPtr,
  18.  CloseScreen,CloseWindow,DisplayAlert,OpenScreen,OpenWindow,ScreenToBack,
  19.  ScreenToFront;
  20.  
  21.  
  22. PROCEDURE CreateScreen(x, y, w, h: INTEGER; v: ViewModeSet): ScreenPtr;
  23.  VAR
  24.   ns: NewScreen;
  25.  BEGIN
  26.   WITH ns DO
  27.    leftEdge:=x; topEdge:=y; width:=w; height:=h; depth:=2;
  28.    detailPen:=255; blockPen:=255;
  29.    viewModes:=v;
  30.    type:=ScreenFlagSet{};
  31.    font:=NIL; defaultTitle:=NIL; gadgets:=NIL; customBitMap:=NIL
  32.   END;
  33.   RETURN OpenScreen(ns)
  34.  END CreateScreen;
  35.  
  36.  
  37. PROCEDURE CreateWindow(x, y, w, h: INTEGER;
  38.                        if: IDCMPFlagSet;
  39.                        wf: WindowFlagSet;
  40.                        g, s, t: ADDRESS): WindowPtr;
  41.  VAR
  42.   nw: NewWindow;
  43.  BEGIN
  44.   WITH nw DO
  45.    leftEdge:=x; topEdge:=y; width:=w; height:=h;
  46.    detailPen:=0; blockPen:=1;
  47.    idcmpFlags:=if; flags:=wf; firstGadget:=g; checkMark:=NIL;
  48.    title:=t; screen:=s; bitMap:=NIL; minWidth:=w; minHeight:=h;
  49.    maxWidth:=w; maxHeight:=h; type:=ScreenFlagSet{wbenchScreen}
  50.   END;
  51.   RETURN OpenWindow(nw)
  52.  END CreateWindow;
  53.  
  54.  
  55. VAR
  56.  scr, wb: ScreenPtr;
  57.  win: WindowPtr;
  58.  rp: RastPortPtr;
  59.  wbm,mbm: BitMapPtr;
  60.  x, y, n: LONGINT;
  61.  i: INTEGER;
  62.  
  63. PROCEDURE Cleanup;
  64.  BEGIN
  65.   IF scr#NIL THEN CloseScreen(scr) END;
  66.   IF win#NIL THEN CloseWindow(win) END
  67.  END Cleanup;
  68.  
  69. VAR
  70.  msg: RECORD
  71.   x1: CARDINAL; s1: ARRAY [0..59] OF CHAR; (* even number of chars !! *)
  72.   x2: CARDINAL; s2: ARRAY [0..37] OF CHAR
  73.  END;
  74. BEGIN
  75.  scr:=NIL; win:=NIL;
  76.  msg.s1:="*Software Failure.   Press left mouse button to continue. ";
  77.  msg.x1:=96; msg.s1[0]:=CHAR(15); msg.s1[59]:=CHAR(1);
  78.  msg.s2:="* Guru Meditation #00019987.000JR000";
  79.  msg.x2:=176; msg.s2[0]:=CHAR(28); msg.s2[37]:=CHAR(0);
  80.  TermProcedure(Cleanup);
  81.  win:=CreateWindow(0, 30, 100, 10, IDCMPFlagSet{},
  82.                    WindowFlagSet{windowDrag, windowDepth, activate},
  83.                    NIL, NIL, ADR("Tilt!"));
  84.  Assert(win#NIL, ADR("Fehler beim Öffnen des Fensters"));
  85.  wb:=win^.wScreen;(* Workbench Screen  *)
  86.  WITH wb^ DO
  87.   scr:=CreateScreen(leftEdge, topEdge, width, height, viewPort.modes)
  88.  END;
  89.  Assert(scr#NIL, ADR("Fehler beim Öffnen des Screens"));
  90.  ScreenToBack(scr);
  91.  rp:=ADR(scr^.rastPort);
  92.  mbm:=rp^.bitMap;
  93.  wbm:=win^.wScreen^.rastPort.bitMap;
  94.  SETREG(0, BltBitMap(wbm, 0, 0, mbm, 0, 0,
  95.                      scr^.width,scr^.height, 0C0H, 0FFH, NIL));
  96.  y:=scr^.height-1;
  97.  FOR i:=0 TO 39 DO x:=16*i; ScrollRaster(rp,0,i-20,x,0,x+15,y) END; 
  98.  x:=scr^.width-1;
  99.  n:=scr^.height DIV 50;
  100.  FOR i:=0 TO 49 DO y:=i*n; ScrollRaster(rp,25-i,0,0,y,x,y+n-1) END;
  101.  ScreenToFront(scr);
  102.  Delay(50);
  103.  IF DisplayAlert(recoveryAlert, ADR(msg), 40) THEN END;
  104. END tilt.mod
  105.