home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / games / misc / nativesc.lha / NativeScreen.mod < prev    next >
Encoding:
Text File  |  1994-11-23  |  4.7 KB  |  157 lines
  1. (*******************************************************************************
  2.  : Program.         NativeScreen.MOD
  3.  : Author.          Carsten Wartmann
  4.  : Address.         Wutzkyallee 83, D-1000 Berlin 47
  5.  : Phone.           030/6614776
  6.  : E-Mail           C.Wartmann@AMBO.in-berlin.de
  7.  : Version.         1.0
  8.  : Date.            11/94
  9.  : Copyright.       PD (Please e-mail me for suggestions !)
  10.  : Language.        Modula-2
  11.  : Compiler.        M2Amiga V4.3d
  12.  : Contents.        Makes several games run with Picasso/EGS-Spektrum WB .
  13.  : Remark.          OS 2.0 only !!!!!!!!!!!!!!!!!!!!!!!!!
  14. *******************************************************************************)
  15.  
  16.  
  17. MODULE NativeScreen ;
  18.  
  19.  
  20. FROM SYSTEM       IMPORT BITSET,ADR,ADDRESS,ASSEMBLE,TAG,LONGSET ;
  21.  
  22. FROM Arts         IMPORT Assert ;
  23.  
  24. FROM ExecSupport IMPORT CreatePort,DeletePort ;
  25.  
  26. FROM ExecL       IMPORT WaitPort,ReplyMsg,GetMsg,execVersion,AllocMem,FreeMem,
  27.                         FindPort,PutMsg,Forbid,Permit ;
  28. FROM ExecD       IMPORT MsgPortPtr,Message,MessagePtr,MemReqs,MemReqSet,
  29.                         NodeType ;
  30.  
  31. FROM DosL         IMPORT Delay ;
  32.  
  33. FROM IntuitionL   IMPORT OpenScreenTagList,CloseScreen,OpenWindowTagList,
  34.                          CloseWindow,DisplayBeep,EasyRequestArgs,
  35.                          SetMenuStrip,ClearMenuStrip ;
  36. FROM IntuitionD   IMPORT NewScreen,ScreenPtr,customScreen,NewWindow,WindowPtr,
  37.                          IntuiMessage,IDCMPFlags,IDCMPFlagSet,WindowFlags,
  38.                          WindowFlagSet,SaTags,WaTags,DrawPens,IntuiMessagePtr,
  39.                          MenuItemFlags,MenuItemFlagSet,Gadget,GadgetPtr,
  40.                          EasyStruct,GaTags ;
  41.  
  42. FROM GraphicsL    IMPORT Move,Draw,SetAPen,WaitBOVP,RectFill,LoadRGB4,
  43.                          WritePixel,ReadPixel,DrawEllipse,
  44.                          ScrollRaster,ScrollVPort,WaitTOF,SetDrMd,
  45.                          Text,OpenFont,CloseFont,SetFont,AskSoftStyle,
  46.                          SetSoftStyle ;
  47. FROM GraphicsD    IMPORT ViewModes,ViewModeSet,jam1,
  48.                          RastPortPtr,ViewPortPtr,ViewPtr,TextAttr,TextFontPtr,
  49.                          FontStyleSet,FontStyles,FontFlagSet,FontFlags,
  50.                          hireslaceKey,loresKey ;
  51.  
  52. (* Grundlegende Tag-Hilfen *)
  53. FROM UtilityD     IMPORT tagDone,TagItem,TagItemPtr,Tag,TagPtr ;
  54. FROM UtilityL     IMPORT AllocateTagItems,FreeTagItems ;
  55.  
  56.  
  57.  
  58.  
  59. (*Versionsstring für OS 2.0 (version) muß im Programm nochmal verwendet
  60.   werden, da der Compiler ungenutzte Konstanten "wegoptimiert" !        *)
  61.  
  62. CONST Version  = "$VER: NativeScreen V1.0 (22.11.94)" ;
  63.       PortName = "NativeScreenPort" ;
  64.  
  65.  
  66. TYPE TstMsg=RECORD
  67.        msg  : Message ;
  68.        text : ARRAY [0..80] OF CHAR ;
  69.      END ;
  70.  
  71.  
  72.  
  73. VAR screenptr     : ScreenPtr ;            (* Screen und Window Pointer *)
  74.     port,rport    : MsgPortPtr ;
  75.     mail          : TstMsg ;
  76.     mailptr       : POINTER TO TstMsg ;
  77.     msgmem        : ADDRESS ;
  78.  
  79.     version       : ARRAY [0..40] OF CHAR ;     (* Hält nachher Versionsstr. *)
  80.  
  81.     mytags        : ARRAY [0..40] OF LONGINT ;  (* Buffer für die Tags       *)
  82.  
  83.     pens          : INTEGER ;
  84.  
  85.  
  86.  
  87.  
  88. PROCEDURE OpenAll ;
  89.  
  90.   BEGIN (* Öffnen des Screens und Windows *)
  91.  
  92.     (* Versionscheck damit wir unter uns (2.0) bleiben...*)
  93.     Assert(execVersion>36,ADR("PRG ist ohne OS 2.0 nicht lauffähig !")) ;
  94.  
  95.     pens := -1 ;   (* Macht Intui klar daß wir die WB-Farben wollen *)
  96.  
  97.     (* Bildschirm mit Hilfe der Tags öffnen *)
  98.     screenptr := OpenScreenTagList(NIL,TAG(mytags,
  99.                            saWidth,             320,
  100.                            saHeight,            256,
  101.                            saDisplayID,        loresKey,
  102.                            saDepth,        1,
  103.                            saPens,        ADR(pens),
  104.                            tagDone)) ;
  105.     Assert(screenptr#NIL,ADR("Nix Bildschirm...")) ; (* offen ??? *)
  106.  
  107.   END OpenAll ;
  108.  
  109.  
  110.  
  111. BEGIN
  112.  
  113.   version := Version ;  (* So gehts immerhin... *)
  114.  
  115.   Forbid() ;
  116.   port := FindPort(ADR(PortName)) ;
  117.   IF port=NIL THEN
  118.     port := CreatePort(ADR(PortName),0) ;
  119.     OpenAll ;
  120.  
  121.     WaitPort(port) ;
  122.     mailptr := GetMsg(port) ;
  123.     IF mailptr#NIL THEN
  124.       mailptr^.text := "Jaaa ???" ;
  125.       ReplyMsg(mailptr) ;
  126.       DeletePort(port) ;
  127.     END ;
  128.   ELSE
  129.     rport := CreatePort(NIL,0) ;
  130.     mailptr := AllocMem(SIZE(TstMsg),MemReqSet{memClear,public}) ;
  131.     mailptr^.msg.node.type := NodeType{message} ;
  132.     mailptr^.msg.length    := SIZE(TstMsg) ;
  133.     mailptr^.msg.replyPort := rport ;
  134.     mailptr^.text          := "Hallo !!" ;
  135.     PutMsg(port,mailptr) ;
  136.     WaitPort(rport) ;
  137.  
  138.     mailptr := GetMsg(rport) ;
  139.  
  140.     DeletePort(rport) ;
  141.  
  142.     (* Brav die Resourcen zurückgeben *)
  143.     IF mailptr#NIL THEN
  144.       FreeMem(mailptr,SIZE(mail)) ;
  145.     END ;
  146.   END ;
  147.   Permit() ;
  148.  
  149.  
  150. CLOSE
  151.  
  152.   IF screenptr # NIL THEN
  153.     CloseScreen(screenptr) ;
  154.   END (*IF*) ;
  155.  
  156. END NativeScreen .
  157.