home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Archives / Drivers / MemBoardTest.lha / MemBoardTest / myscreen.mod < prev    next >
Encoding:
Modula Implementation  |  1988-10-02  |  12.4 KB  |  441 lines
  1. IMPLEMENTATION MODULE myscreen;
  2.  
  3. (* DECLARE bittextintui, bittext, bitgadg *)
  4.  
  5.  
  6.  
  7. FROM SYSTEM IMPORT ADR, ADDRESS, BYTE, WORD, NULL;
  8. FROM Libraries IMPORT OpenLibrary, CloseLibrary;
  9. FROM Colors IMPORT ColorMap, ColorMapPtr;
  10. FROM GraphicsLibrary IMPORT GraphicsName, GraphicsBase, BitMap;
  11.  
  12. FROM Views IMPORT ModeSet,Modes;
  13. FROM Text IMPORT Text;
  14. FROM Pens IMPORT SetAPen,SetDrMd,Move,Draw,RectFill;
  15. FROM InOut IMPORT WriteString, WriteLn;
  16. FROM Windows IMPORT OpenWindow, CloseWindow;
  17. FROM Intuition IMPORT GadgetFlagSet,GadgetFlags,
  18.      ActivationFlagSet,ActivationFlags,IntuitionName,IntuitionBase,
  19.      Gadget,GadgetPtr,Requester,BorderPtr,Border,Screen,ScreenFlagSet,
  20.      ScreenPtr,ScreenFlags,RethinkDisplay,RemakeDisplay,CustomScreen,
  21.      WindowFlags, WindowFlagSet, NewWindow, Window, IDCMPFlags, IDCMPFlagSet,
  22.      IntuiMessage, IntuiMessagePtr, IntuitionText, IntuitionTextPtr,
  23.      WindowPtr;
  24. FROM Screens IMPORT OpenScreen, CloseScreen, NewScreen, WBenchToFront,
  25.   ScreenToFront, MakeScreen;
  26. FROM Rasters IMPORT RastPort;
  27. FROM Strings IMPORT String, Concat, SetTerminator;
  28. FROM Gadgets IMPORT AddGadget, ScreenGadget, StrGadget, BoolGadget,
  29.      RefreshGadgets,RemoveGadget;
  30. FROM mygadg IMPORT decgadg,boolborder;
  31.  
  32.  
  33. VAR
  34.   Width, Height: CARDINAL;
  35.  
  36. VAR
  37.   newscr: NewScreen;
  38.   bittext,rereadtext,errtext,looptext : String;
  39.   bittextintui,rereadtextintui : IntuitionText;
  40.   strborder1,strborder2,selectborder: Border;
  41.   strpairs1,strpairs2,selectpairs : ARRAY[0..30] OF WORD;
  42.   fileofftext,fileontext : String;
  43.   fileofftextintui, fileontextintui, errtextintui, loopertextintui : IntuitionText;
  44.   bitgadg, fileongadg, fileoffgadg : Gadget;
  45.  
  46. PROCEDURE InitScreen(width, height, depth: CARDINAL): BOOLEAN;
  47. CONST JAM1   =  0;       (* jam 1 color into raster *)
  48.       JAM2   =  1;       (* jam 2 colors into raster *)
  49.       COMPLEMENT = 2;       (* XOR bits into raster *)  
  50.       INVERSVID  = 4;       (* inverse video for drawing modes *)
  51.  
  52. VAR 
  53.   CM: ColorMapPtr;
  54.    k : LONGCARD;
  55.    i,j, gadgid,px,py  : CARDINAL;
  56.    igadg : GadgetPtr;
  57.    posn,mx,my : INTEGER;
  58.    newwin : NewWindow;
  59.    quit, done : BOOLEAN;
  60.  
  61. BEGIN
  62.   Width := width;
  63.   Height := height;
  64.   SetTerminator(CHR(0));
  65.   stadrresult := '500000';
  66.   enadrresult := '500010';
  67.   errresult   := '0010';
  68.   looperresult:= '0001';
  69.   screentitle := 'RAMTEST (C) George Vokalek, South Australia,  Apr  1987';
  70.   windowtitle := 'Version 2.40 PROTON MICROELECTRONICS PTY LTD, July 1987';
  71.   sttext := 'Start Address';
  72.   entext := 'End Address';
  73.   errtext := 'Error Limit';
  74.   looptext:= 'Loop Counter';
  75.   
  76.   IF (GraphicsBase = 0) OR (IntuitionBase = 0) THEN RETURN FALSE; END;
  77.  
  78.   WITH newscr DO        (* Setup the Intuition screen *)
  79.       LeftEdge := 0; TopEdge := 0;
  80.       Width := width; Height := height; Depth := depth;
  81.       DetailPen := BYTE(0); BlockPen := BYTE(1);
  82.       ViewModes := ModeSet{Lace,Hires};
  83.       Font := NULL;
  84.       DefaultTitle := ADR(screentitle);
  85.       Gadgets := NULL;
  86.       CustomBitMap := NULL;
  87.       Type := CustomScreen;
  88.       END; (* with *)
  89.  
  90.   ourscreen := ScreenPtr(OpenScreen(ADR(newscr)));
  91.  
  92.   (* initialise the viewport *)
  93.  
  94.   WITH ourscreen^.VPort DO
  95.     CM := colorMap;
  96.     WITH CM^ DO
  97.       type := BYTE(0);  (* ARRAY xRGB *)
  98.       flags := BYTE(0);
  99.       count := 1;
  100.  
  101.       (* calculate number of colour entries in ColourTable[] *)
  102.       WHILE depth > 0 DO
  103.         count := count * 2;
  104.         DEC(depth);
  105.       END;
  106.       FOR i := 0 TO count-1 DO
  107.         colorTable^[i] := ColourTable[i];
  108.       END;
  109.     END;
  110.   END;
  111.  
  112.   ScreenToFront(ourscreen);
  113.   RemakeDisplay();
  114.   RethinkDisplay();
  115.  
  116.    WITH stadrtextintui DO
  117.       FrontPen := BYTE(1);
  118.       BackPen  := BYTE(0);
  119.       DrawMode := BYTE(JAM1);
  120.       LeftEdge := 10;
  121.       TopEdge  := -11;
  122.       ITextFont := NULL;
  123.       IText := ADR(sttext);
  124.       NextText := NULL;
  125.       END;
  126.  
  127.    WITH enadrtextintui DO
  128.       FrontPen := BYTE(1);
  129.       BackPen  := BYTE(0);
  130.       DrawMode := BYTE(JAM1);
  131.       LeftEdge := 10;
  132.       TopEdge  := -11;
  133.       ITextFont := NULL;
  134.       IText := ADR(entext);
  135.       NextText := NULL;
  136.       END;
  137.  
  138.    WITH errtextintui DO
  139.       FrontPen := BYTE(1);
  140.       BackPen  := BYTE(0);
  141.       DrawMode := BYTE(JAM1);
  142.       LeftEdge := -15;
  143.       TopEdge  := -11;
  144.       ITextFont := NULL;
  145.       IText := ADR(errtext);
  146.       NextText := NULL;
  147.       END;
  148.  
  149.    WITH loopertextintui DO
  150.       FrontPen := BYTE(1);
  151.       BackPen  := BYTE(0);
  152.       DrawMode := BYTE(JAM1);
  153.       LeftEdge := -15;
  154.       TopEdge  := -11;
  155.       ITextFont := NULL;
  156.       IText := ADR(looptext);
  157.       NextText := NULL;
  158.       END;
  159.  
  160.       
  161.    WITH stgadgstring DO
  162.       Buffer     := ADR(stadrresult);
  163.       UndoBuffer := ADR(stadrresult);
  164.       BufferPos  := 0;
  165.       MaxChars   := 8;
  166.       DispPos    := 0;
  167.       UndoPos    := 0;
  168.       NumChars   := 8;
  169.       DispCount  := 0;
  170.       CLeft      := 5;
  171.       CTop       := 3;
  172.       Layer      := NULL;
  173.       LongInt    := 0;
  174.       AltKeyMap  := NULL;     
  175.       END; (* WITH *)
  176.  
  177.    WITH engadgstring DO
  178.       Buffer     := ADR(enadrresult);
  179.       UndoBuffer := ADR(enadrresult);
  180.       BufferPos  := 0;
  181.       MaxChars   := 8;
  182.       DispPos    := 0;
  183.       UndoPos    := 0;
  184.       NumChars   := 8;
  185.       DispCount  := 0;
  186.       CLeft      := 5;
  187.       CTop       := 3;
  188.       Layer      := NULL;
  189.       LongInt    := 0;
  190.       AltKeyMap  := NULL;     
  191.       END; (* WITH *)
  192.          
  193.    WITH errgadgstring DO
  194.       Buffer     := ADR(errresult);
  195.       UndoBuffer := ADR(errresult);
  196.       BufferPos  := 0;
  197.       MaxChars   := 6;
  198.       DispPos    := 0;
  199.       UndoPos    := 0;
  200.       NumChars   := 6;
  201.       DispCount  := 0;
  202.       CLeft      := 5;
  203.       CTop       := 3;
  204.       Layer      := NULL;
  205.       LongInt    := 0;
  206.       AltKeyMap  := NULL;     
  207.       END; (* WITH *)
  208.          
  209.    WITH loopergadgstring DO
  210.       Buffer     := ADR(looperresult);
  211.       UndoBuffer := ADR(looperresult);
  212.       BufferPos  := 0;
  213.       MaxChars   := 6;
  214.       DispPos    := 0;
  215.       UndoPos    := 0;
  216.       NumChars   := 6;
  217.       DispCount  := 0;
  218.       CLeft      := 5;
  219.       CTop       := 3;
  220.       Layer      := NULL;
  221.       LongInt    := 0;
  222.       AltKeyMap  := NULL;     
  223.       END; (* WITH *)
  224.          
  225.      strpairs1[0] := WORD(-1);   
  226.      strpairs1[1] := WORD(-2);   
  227.      strpairs1[2] := WORD(130);  
  228.      strpairs1[3] := WORD(-2);   
  229.      strpairs1[4] := WORD(130);  
  230.      strpairs1[5] := WORD(-20);
  231.      strpairs1[6] := WORD(150);  
  232.      strpairs1[7] := WORD(8);
  233.      strpairs1[8] := WORD(130);  
  234.      strpairs1[9] := WORD(36);   
  235.      strpairs1[10] := WORD(130);         
  236.      strpairs1[11] := WORD(18);  
  237.      strpairs1[12] := WORD(-1);  
  238.      strpairs1[13] := WORD(18);  
  239.      strpairs1[14] := WORD(-1);  
  240.      strpairs1[15] := WORD(-2);  
  241.          
  242.      
  243.      WITH strborder1 DO
  244.          LeftEdge := -1;
  245.          TopEdge := -1;
  246.          FrontPen := BYTE(1);
  247.          BackPen  := BYTE(0);
  248.          DrawMode := BYTE(JAM1);
  249.          Count    := BYTE(8);
  250.          XY       := ADR(strpairs1);
  251.          NextBorder := BorderPtr(NULL);
  252.          END; (* with *)
  253.          
  254.          
  255.      strpairs2[0] := WORD(-1);   
  256.      strpairs2[1] := WORD(-2);   
  257.      strpairs2[2] := WORD(150);  
  258.      strpairs2[3] := WORD(-2);   
  259.      strpairs2[4] := WORD(150);  
  260.      strpairs2[5] := WORD(-20);
  261.      strpairs2[6] := WORD(170);  
  262.      strpairs2[7] := WORD(8);
  263.      strpairs2[8] := WORD(150);  
  264.      strpairs2[9] := WORD(36);   
  265.      strpairs2[10] := WORD(150);         
  266.      strpairs2[11] := WORD(18);  
  267.      strpairs2[12] := WORD(-1);  
  268.      strpairs2[13] := WORD(18);  
  269.      strpairs2[14] := WORD(-1);  
  270.      strpairs2[15] := WORD(-2);  
  271.          
  272.      
  273.      WITH strborder2 DO
  274.          LeftEdge := -1;
  275.          TopEdge := -1;
  276.          FrontPen := BYTE(1);
  277.          BackPen  := BYTE(0);
  278.          DrawMode := BYTE(JAM1);
  279.          Count    := BYTE(8);
  280.          XY       := ADR(strpairs2);
  281.          NextBorder := BorderPtr(NULL);
  282.          END; (* with *)
  283.          
  284.      selectpairs[0] := WORD(-1);         
  285.      selectpairs[1] := WORD(-2);         
  286.      selectpairs[2] := WORD(150);        
  287.      selectpairs[3] := WORD(-2);         
  288.      selectpairs[10] := WORD(150);       
  289.      selectpairs[11] := WORD(18);        
  290.      selectpairs[12] := WORD(-1);        
  291.      selectpairs[13] := WORD(18);        
  292.      selectpairs[14] := WORD(-1);        
  293.      selectpairs[15] := WORD(-2);        
  294.          
  295.      
  296.      WITH selectborder DO
  297.          LeftEdge := -1;
  298.          TopEdge := -1;
  299.          FrontPen := BYTE(1);
  300.          BackPen  := BYTE(0);
  301.          DrawMode := BYTE(JAM1);
  302.          Count    := BYTE(5);
  303.          XY       := ADR(selectpairs);
  304.          NextBorder := BorderPtr(NULL);
  305.          END; (* with *)
  306.          
  307.      
  308.       WITH stadrgadg DO
  309.          NextGadget := GadgetPtr(ADR(enadrgadg));
  310.          LeftEdge   := 100;
  311.          TopEdge    := 30;
  312.          Width      := 70;
  313.          Height     := 12;
  314.          Flags      := GadgetFlagSet{};
  315.          Activation := ActivationFlagSet{GadgetImmediate,RelVerify};
  316.          GadgetType := StrGadget;
  317.          GadgetRender := ADR(strborder1);
  318.          SelectRender := NULL;
  319.          GadgetText := IntuitionTextPtr(ADR(stadrtextintui));
  320.          MutualExclude := 0;
  321.          SpecialInfoString   := ADR(stgadgstring);
  322.          GadgetID := 10;
  323.          END; (* WITH *)
  324.  
  325.      
  326.       WITH enadrgadg DO
  327.          NextGadget := GadgetPtr(ADR(errnogadg));
  328.          LeftEdge   := 100;
  329.          TopEdge    := 60;
  330.          Width      := 70;
  331.          Height     := 12;
  332.          Flags      := GadgetFlagSet{};
  333.          Activation := ActivationFlagSet{GadgetImmediate,RelVerify};
  334.          GadgetType := StrGadget;
  335.          GadgetRender := ADR(strborder2);
  336.          SelectRender := NULL;
  337.          GadgetText := IntuitionTextPtr(ADR(enadrtextintui));
  338.          MutualExclude := 0;
  339.          SpecialInfoString   := ADR(engadgstring);
  340.          GadgetID := 11;
  341.          END; (* WITH *)
  342.  
  343.       WITH errnogadg DO
  344.          NextGadget := GadgetPtr(ADR(loopergadg));
  345.          LeftEdge   := 20;
  346.          TopEdge    := 60;
  347.          Width      := 60;
  348.          Height     := 12;
  349.          Flags      := GadgetFlagSet{};
  350.          Activation := ActivationFlagSet{GadgetImmediate,RelVerify};
  351.          GadgetType := StrGadget;
  352.          GadgetRender := ADR(boolborder);
  353.          SelectRender := NULL;
  354.          GadgetText := IntuitionTextPtr(ADR(errtextintui));
  355.          MutualExclude := 0;
  356.          SpecialInfoString   := ADR(errgadgstring);
  357.          GadgetID := 12;
  358.          END; (* WITH *)
  359.  
  360.  
  361.       WITH loopergadg DO
  362.          NextGadget := GadgetPtr(ADR(decgadg));
  363.          LeftEdge   := 180;
  364.          TopEdge    := 120;
  365.          Width      := 60;
  366.          Height     := 12;
  367.          Flags      := GadgetFlagSet{};
  368.          Activation := ActivationFlagSet{GadgetImmediate,RelVerify};
  369.          GadgetType := StrGadget;
  370.          GadgetRender := ADR(boolborder);
  371.          SelectRender := NULL;
  372.          GadgetText := IntuitionTextPtr(ADR(loopertextintui));
  373.          MutualExclude := 0;
  374.          SpecialInfoString   := ADR(loopergadgstring);
  375.          GadgetID := 13;
  376.          END; (* WITH *)
  377.  
  378.  
  379.       WITH newwin DO
  380.          LeftEdge := 0;
  381.          TopEdge  := 15;
  382.          Width    := width;
  383.          Height   := height - 20;
  384.          DetailPen := BYTE(0);
  385.          BlockPen := BYTE(1);
  386.          FirstGadget := GadgetPtr(ADR(stadrgadg));
  387.          Title := ADR(windowtitle);
  388.          Screen := ourscreen;
  389.          BitMap := NULL;
  390.          Type := CustomScreen;
  391.          END; (* with *)
  392.  
  393.       newwin.Flags:=WindowFlagSet{BackDrop,Borderless,WindowClose,
  394.                                  Activate,NoCareRefresh,RMBTrap};
  395.       newwin.IDCMPFlags:=IDCMPFlagSet{CloseWindowFlag,GadgetUp,GadgetDown,
  396.                                       MouseButtons};
  397.          
  398.    WriteString('about to open window');
  399.    WriteLn;
  400.    ourwindow := OpenWindow(newwin);
  401.    WriteString('window now open');
  402.    WriteLn; 
  403.       
  404.  
  405.    RP:=ADR(ourscreen^.RPort);
  406.       
  407.    RETURN TRUE;
  408.  
  409. END InitScreen;
  410.  
  411.  
  412. PROCEDURE Refresh;
  413. VAR dummy:Requester;
  414. BEGIN
  415.    RefreshGadgets(ADR(stadrgadg),ourwindow,ADR(dummy)); 
  416. END Refresh;   
  417.    
  418.    
  419. PROCEDURE EndMake;
  420. BEGIN
  421.    CloseWindow(WindowPtr(ourwindow));
  422.    CloseScreen(ourscreen);
  423.    
  424.    CloseLibrary(GraphicsBase);
  425.    CloseLibrary(IntuitionBase);
  426. END EndMake;
  427.  
  428.  
  429. BEGIN
  430.    GraphicsBase := OpenLibrary(GraphicsName,0);
  431.    IntuitionBase := OpenLibrary(IntuitionName,0);
  432.    ColourTable[0] := 0777H;  (* black *)
  433.    ColourTable[1] := 0000H;  (* green *)
  434.    ColourTable[2] := 000FH;  (* blue *)
  435.    ColourTable[3] := 0F00H;  (* red *)
  436.    ColourTable[4] := 0FFFH;  (* white *)
  437.    ColourTable[7] := 008FH;  (* purple, complement of black *) 
  438.    ColourTable[6] := 00F0H;  (* yellow, complement of green *)
  439. END myscreen.
  440.  
  441.