home *** CD-ROM | disk | FTP | other *** search
/ World of A1200 / World_Of_A1200.iso / programs / emulator / appleonamiga / txt / applescreen.mod < prev    next >
Text File  |  1995-02-27  |  13KB  |  419 lines
  1. IMPLEMENTATION MODULE AppleScreen;
  2.  
  3. FROM SYSTEM IMPORT ADDRESS,ADR,BITSET,LONGSET,TAG;
  4.  
  5. FROM Base37 IMPORT A,B,N;
  6.  
  7. IMPORT
  8.  ACASLReq,d:DosD,D:DosL,e:ExecD,E:ExecL,g:GraphicsD,G:GraphicsL,i:IntuitionD,I:IntuitionL
  9.  ,u:UtilityD;
  10.  
  11. CONST
  12.  blinkName="AppleBlinkProc";
  13.  errNoScreen="No screen";
  14.  errNoWindow="No window";
  15.  errHeight="Window heigt <192";
  16.  errWidth="Window width <280";
  17.  kbdName="AppleKBDProc";
  18.  screenFont="topaz.font";
  19.  title="Apple 2 Emulator V0.1, 03-Jan-1993/cn";
  20.  
  21.  disk1Menu="Disk 1";
  22.  disk2Menu="Disk 2";
  23.  diskItemLoad="Load Disk...";
  24.  diskItemUnLoad="Unload Disk";
  25.  diskItemWriteProtect="Write protected";
  26.  projectMenu="Project";
  27.  projectItemQuit="Quit";
  28.  
  29.  load1="Load Disk 1";
  30.  load2="Load Disk 2";
  31.  
  32. TYPE
  33.  Color32=ARRAY [0..32] OF i.ColorSpec;
  34.  Palette=ARRAY [0..15] OF [0..31];
  35.  Pens=ARRAY [0..12] OF INTEGER;
  36.  
  37. CONST
  38.  appleColors=Color32{
  39.   i.ColorSpec{colorIndex:0,red:10,green:10,blue:10}, (* WB 0 *)
  40.   i.ColorSpec{colorIndex:1,red:0,green:0,blue:0}, (* WB 1 *)
  41.   i.ColorSpec{colorIndex:2,red:15,green:15,blue:15}, (* WB 2 *)
  42.   i.ColorSpec{colorIndex:3,red:6,green:8,blue:11}, (* WB 3 *)
  43.   i.ColorSpec{colorIndex:4,red:14,green:4,blue:4}, (* WB 4 *)
  44.   i.ColorSpec{colorIndex:5,red:5,green:13,blue:5}, (* WB 5 *)
  45.   i.ColorSpec{colorIndex:6,red:0,green:4,blue:13}, (* WB 6 *)
  46.   i.ColorSpec{colorIndex:7,red:14,green:9,blue:0} (* WB 7 *)
  47.  
  48.   i.ColorSpec{colorIndex:8,red:0,green:0,blue:0},    (* black = hires 0 and 4 *)
  49.   i.ColorSpec{colorIndex:9,red:8,green:0,blue:4}, (* magenta *)
  50.   i.ColorSpec{colorIndex:10,red:0,green:0,blue:6}, (* dark blue *)
  51.   i.ColorSpec{colorIndex:11,red:11,green:0,blue:15}, (* purple = hires 2 *)
  52.   i.ColorSpec{colorIndex:12,red:0,green:15,blue:0}, (* dark green *)
  53.   i.ColorSpec{colorIndex:13,red:9,green:9,blue:9}, (* grey 1 *)
  54.   i.ColorSpec{colorIndex:14,red:0,green:6,blue:12}, (* medium blue = hires 6 *)
  55.   i.ColorSpec{colorIndex:15,red:0,green:13,blue:13}, (* light blue *)
  56.  
  57.   i.ColorSpec{colorIndex:16,red:3,green:3,blue:3},
  58.   i.ColorSpec{colorIndex:17,red:14,green:4,blue:4}, (* POINTER 1 *)
  59.   i.ColorSpec{colorIndex:18,red:0,green:0,blue:0}, (* POINTER 2 *)
  60.   i.ColorSpec{colorIndex:19,red:14,green:14,blue:12}, (* POINTER 3 *)
  61.   i.ColorSpec{colorIndex:20,red:15,green:15,blue:15}, (* Blinking white/black *)
  62.   i.ColorSpec{colorIndex:21,red:0,green:0,blue:0}, (* Blinking black/white *)
  63.   i.ColorSpec{colorIndex:22,red:6,green:6,blue:6},
  64.   i.ColorSpec{colorIndex:23,red:7,green:7,blue:7},
  65.  
  66.   i.ColorSpec{colorIndex:24,red:8,green:5,blue:0}, (* brown *)
  67.   i.ColorSpec{colorIndex:25,red:15,green:8,blue:0}, (* orange = hires 5 *)
  68.   i.ColorSpec{colorIndex:26,red:8,green:8,blue:8}, (* grey 2 *)
  69.   i.ColorSpec{colorIndex:27,red:15,green:11,blue:11}, (* pink *)
  70.   i.ColorSpec{colorIndex:28,red:0,green:13,blue:0}, (* green = hires 1 *)
  71.   i.ColorSpec{colorIndex:29,red:15,green:15,blue:0}, (* yellow *)
  72.   i.ColorSpec{colorIndex:30,red:0,green:9,blue:13}, (* aqua *)
  73.   i.ColorSpec{colorIndex:31,red:15,green:15,blue:15}, (* white = hires 3 and 7 *)
  74.  
  75.   i.ColorSpec{colorIndex:-1,red:0,green:0,blue:0} (* Terminate color list *)
  76.  };
  77.  applePalette=Palette{8,9,10,11,12,13,14,15,24,25,26,27,28,29,30,31};
  78.  
  79.  black=8; white=31;
  80.  blinkBlack=20; blinkWhite=21;
  81.  
  82.  wb0=0; wb1=1; wb2=2; wb3=3; wb4=4; wb5=5; wb6=6; wb7=7;
  83.  pens=Pens{wb0,wb1,wb1,wb2,wb1,wb3,wb1,wb0,wb2,wb1,wb2,wb1,-1};
  84.  
  85. CONST
  86.  menuWidth=80;
  87.  menu0L=10; menu1L=menu0L+menuWidth; menu2L=menu1L+menuWidth;
  88.  menuItemWidth=2*menuWidth;
  89.  menuItemHeight=10;
  90.  menuItem1T=0;
  91.  menuItem2T=menuItem1T+menuItemHeight;
  92.  menuItem3T=menuItem2T+menuItemHeight;
  93.  
  94. VAR
  95.   appleMenuItem3:=i.MenuItem{
  96.    nextItem:NIL
  97.    ,leftEdge:0,topEdge:menuItem3T,width:menuItemWidth,height:menuItemHeight
  98.    ,flags:i.MenuItemFlagSet{i.itemText,i.itemEnabled,i.highComp,i.checkIt,i.menuToggle}
  99.    ,mutualExclude:LONGSET{}
  100.    ,itemFill:ADR(i.IntuiText{
  101.     frontPen:2,backPen:1,drawMode:g.jam2,leftEdge:i.checkWidth,topEdge:0,iTextFont:NIL
  102.     ,iText:ADR(diskItemWriteProtect),nextText:NIL
  103.    })
  104.    ,selectFill:NIL,command:" ",subItem:NIL,nextSelect:0
  105.   };
  106.   appleMenuItem2:=i.MenuItem{
  107.    nextItem:ADR(appleMenuItem3)
  108.    ,leftEdge:0,topEdge:menuItem2T,width:menuItemWidth,height:menuItemHeight
  109.    ,flags:i.MenuItemFlagSet{i.itemText,i.itemEnabled,i.highComp}
  110.    ,mutualExclude:LONGSET{}
  111.    ,itemFill:ADR(i.IntuiText{
  112.     frontPen:2,backPen:1,drawMode:g.jam2,leftEdge:0,topEdge:0,iTextFont:NIL
  113.     ,iText:ADR(diskItemUnLoad),nextText:NIL
  114.    })
  115.    ,selectFill:NIL,command:" ",subItem:NIL,nextSelect:0
  116.   };
  117.  appleMenuItem1:=i.MenuItem{
  118.    nextItem:ADR(appleMenuItem2)
  119.    ,leftEdge:0,topEdge:menuItem1T,width:menuItemWidth,height:menuItemHeight
  120.    ,flags:i.MenuItemFlagSet{i.itemText,i.itemEnabled,i.highComp}
  121.    ,mutualExclude:LONGSET{}
  122.    ,itemFill:ADR(i.IntuiText{
  123.     frontPen:2,backPen:1,drawMode:g.jam2,leftEdge:0,topEdge:0,iTextFont:NIL
  124.     ,iText:ADR(diskItemLoad),nextText:NIL
  125.    })
  126.    ,selectFill:NIL,command:" ",subItem:NIL,nextSelect:0
  127.   };
  128.  
  129.   appleMenuItem6:=i.MenuItem{
  130.    nextItem:NIL
  131.    ,leftEdge:0,topEdge:menuItem3T,width:menuItemWidth,height:menuItemHeight
  132.    ,flags:i.MenuItemFlagSet{i.itemText,i.itemEnabled,i.highComp,i.checkIt,i.menuToggle}
  133.    ,mutualExclude:LONGSET{}
  134.    ,itemFill:ADR(i.IntuiText{
  135.     frontPen:2,backPen:1,drawMode:g.jam2,leftEdge:i.checkWidth,topEdge:0,iTextFont:NIL
  136.     ,iText:ADR(diskItemWriteProtect),nextText:NIL
  137.    })
  138.    ,selectFill:NIL,command:" ",subItem:NIL,nextSelect:0
  139.   };
  140.   appleMenuItem5:=i.MenuItem{
  141.    nextItem:ADR(appleMenuItem6)
  142.    ,leftEdge:0,topEdge:menuItem2T,width:menuItemWidth,height:menuItemHeight
  143.    ,flags:i.MenuItemFlagSet{i.itemText,i.itemEnabled,i.highComp}
  144.    ,mutualExclude:LONGSET{}
  145.    ,itemFill:ADR(i.IntuiText{
  146.     frontPen:2,backPen:1,drawMode:g.jam2,leftEdge:0,topEdge:0,iTextFont:NIL
  147.     ,iText:ADR(diskItemUnLoad),nextText:NIL
  148.    })
  149.    ,selectFill:NIL,command:" ",subItem:NIL,nextSelect:0
  150.   };
  151.   appleMenuItem4:=i.MenuItem{
  152.    nextItem:ADR(appleMenuItem5)
  153.    ,leftEdge:0,topEdge:menuItem1T,width:menuItemWidth,height:menuItemHeight
  154.    ,flags:i.MenuItemFlagSet{i.itemText,i.itemEnabled,i.highComp}
  155.    ,mutualExclude:LONGSET{}
  156.    ,itemFill:ADR(i.IntuiText{
  157.     frontPen:2,backPen:1,drawMode:g.jam2,leftEdge:0,topEdge:0,iTextFont:NIL
  158.     ,iText:ADR(diskItemLoad),nextText:NIL
  159.    })
  160.    ,selectFill:NIL,command:" ",subItem:NIL,nextSelect:0
  161.   };
  162.  
  163.   appleMenuItem7:=i.MenuItem{
  164.    nextItem:NIL
  165.    ,leftEdge:0,topEdge:menuItem1T,width:menuItemWidth,height:menuItemHeight
  166.    ,flags:i.MenuItemFlagSet{i.itemText,i.itemEnabled,i.highComp}
  167.    ,mutualExclude:LONGSET{}
  168.    ,itemFill:ADR(i.IntuiText{
  169.     frontPen:2,backPen:1,drawMode:g.jam2,leftEdge:0,topEdge:0,iTextFont:NIL
  170.     ,iText:ADR(projectItemQuit),nextText:NIL
  171.    })
  172.    ,selectFill:NIL,command:" ",subItem:NIL,nextSelect:0
  173.   };
  174.  
  175.   appleMenu2:=i.Menu{
  176.    nextMenu:NIL,leftEdge:menu2L,topEdge:0,width:menuWidth,height:0
  177.    ,flags:BITSET{i.menuEnabled},menuName:ADR(disk2Menu),firstItem:ADR(appleMenuItem4)
  178.   };
  179.   appleMenu1:=i.Menu{
  180.    nextMenu:ADR(appleMenu2),leftEdge:menu1L,topEdge:0,width:menuWidth,height:0
  181.    ,flags:BITSET{i.menuEnabled},menuName:ADR(disk1Menu),firstItem:ADR(appleMenuItem1)
  182.   };
  183.  
  184.   appleMenu0:=i.Menu{
  185.    nextMenu:ADR(appleMenu1),leftEdge:menu0L,topEdge:0,width:menuWidth,height:0
  186.    ,flags:BITSET{i.menuEnabled},menuName:ADR(projectMenu),firstItem:ADR(appleMenuItem7)
  187.   };
  188.  
  189. VAR
  190.  appleMenu:i.MenuPtr;
  191.  
  192. CONST
  193.  textPageStart=0400H;
  194.  
  195. VAR
  196.  appleRastPort:g.RastPortPtr;
  197.  appleViewPort:g.ViewPortPtr;
  198.  appleWindow:i.WindowPtr;
  199.  killBlink,killBlinkReply:LONGINT;
  200.  killKBD,killKBDReply:LONGINT;
  201.  mainTask:e.TaskPtr;
  202.  
  203. PROCEDURE BlinkProc;
  204. (*$ LoadA4:=TRUE *)
  205. BEGIN
  206.  killBlink:=E.AllocSignal(-1);
  207.  REPEAT
  208.   G.SetRGB4(appleViewPort,blinkBlack,0,0,0);
  209.   G.SetRGB4(appleViewPort,blinkWhite,15,15,15);
  210.   D.Delay(15);
  211.   G.SetRGB4(appleViewPort,blinkBlack,15,15,15);
  212.   G.SetRGB4(appleViewPort,blinkWhite,0,0,0);
  213.   D.Delay(15);
  214.  UNTIL killBlink IN E.SetSignal(LONGSET{},LONGSET{}); (* Test if killBlink was set. *)
  215.  E.FreeSignal(killBlink);
  216.  E.Signal(mainTask,LONGSET{killBlinkReply});
  217. END BlinkProc;
  218.  
  219. PROCEDURE KBDProc;
  220. (*$ LoadA4:=TRUE *)
  221. VAR
  222.  ch:CHAR;
  223.  class:i.IDCMPFlagSet;
  224.  code:CARDINAL;
  225.  disk:[1..2];
  226.  intuiMsg:i.IntuiMessagePtr;
  227.  item:i.MenuItemPtr;
  228.  signals:LONGSET;
  229. BEGIN
  230.  killKBD:=E.AllocSignal(-1);
  231.  (*
  232.   KBDProc has to create port
  233.  *)
  234.  I.ModifyIDCMP(appleWindow,i.IDCMPFlagSet{i.vanillaKey,i.rawKey,i.menuPick});
  235.  LOOP
  236.   signals:=E.Wait(LONGSET{killKBD,appleWindow^.userPort^.sigBit});
  237.   IF appleWindow^.userPort^.sigBit IN signals THEN
  238.    LOOP
  239.     intuiMsg:=E.GetMsg(appleWindow^.userPort);
  240.     IF intuiMsg=NIL THEN EXIT; END;
  241.     class:=intuiMsg^.class; code:=intuiMsg^.code;
  242.     E.ReplyMsg(intuiMsg);
  243.     IF i.menuPick IN class THEN
  244.      WHILE code#i.menuNull DO
  245.       item:=I.ItemAddress(appleMenu,code);
  246.       CASE code MOD 32 OF
  247.       | 0:
  248.        IF code DIV 32 MOD 64=0 THEN quit(); END;
  249.       | 1,2:
  250.        disk:=code MOD 32;
  251.        CASE (code DIV 32) MOD 64 OF
  252.        | 0:
  253.         diskLoad(disk);
  254.         IF i.checked IN item^.flags THEN diskProtect(disk,TRUE); END;
  255.  
  256.        | 1:
  257.         diskUnload(disk);
  258.        | 2:
  259.         IF i.checked IN item^.flags THEN diskProtect(disk,TRUE);
  260.         ELSE diskProtect(disk,FALSE);
  261.         END;
  262.        END;
  263.       END;
  264.       code:=item^.nextSelect;
  265.      END;
  266.     END;
  267.     IF i.vanillaKey IN class THEN
  268.      ch:=CHR(code MOD 128);
  269.      CASE ch OF
  270.      | "M": ch:="]";
  271.      | "N": ch:="^";
  272.      | "P": ch:="@";
  273.      | "a".."z": ch:=CAP(ch);
  274.      ELSE (* leave it as it is *)
  275.      END;
  276.      lastKey:=80H+ORD(ch);
  277.     END;
  278.     IF i.rawKey IN class THEN
  279.      CASE code OF
  280.      | 05FH: IF reset#NIL THEN reset(); END;
  281.      | 04FH: lastKey:=088H;
  282.      | 04EH: lastKey:=095H;
  283.      ELSE (* ignore all other keys *)
  284.      END;
  285.     END;
  286.    END;
  287.   END;
  288.   IF killKBD IN signals THEN
  289.    EXIT;
  290.   END;
  291.  END;
  292.  (*
  293.   KBDProc has to remove port
  294.  *)
  295.  I.ModifyIDCMP(appleWindow,i.IDCMPFlagSet{});
  296.  E.FreeSignal(killKBD);
  297.  E.Signal(mainTask,LONGSET{killKBDReply});
  298. END KBDProc;
  299.  
  300. PROCEDURE RequestDisk(diskNum:DiskNum; VAR name:ARRAY OF CHAR):BOOLEAN;
  301. VAR
  302.  title:ARRAY [0..39] OF CHAR;
  303. BEGIN
  304.  IF diskNum=1 THEN title:=load1; ELSE title:=load2; END;
  305.  RETURN ACASLReq.FileReq(name,title,"",FALSE);
  306. END RequestDisk;
  307.  
  308. PROCEDURE PutText(line,col:CARDINAL; text:ADDRESS; length:CARDINAL);
  309. VAR
  310.  ch:[0..255];
  311.  i:CARDINAL;
  312.  p:POINTER TO ARRAY [0..9999] OF [0..255];
  313. BEGIN
  314.  p:=text;
  315.  G.SetDrMd(appleRastPort,g.jam2);
  316.  G.Move(appleRastPort,(col+i)*8,line*8+6);
  317.  FOR i:=0 TO length-1 DO
  318.   ch:=p^[i];
  319.   CASE ch DIV 64 OF
  320.   | 0: G.SetAPen(appleRastPort,black); G.SetBPen(appleRastPort,white);
  321.   | 1: G.SetAPen(appleRastPort,blinkBlack); G.SetBPen(appleRastPort,blinkWhite);
  322.   | 2: G.SetAPen(appleRastPort,white); G.SetBPen(appleRastPort,black);
  323.   | 3: G.SetAPen(appleRastPort,white); G.SetBPen(appleRastPort,black);
  324.   END;
  325.   ch:=ch MOD 64; IF ch<32 THEN INC(ch,64); END;
  326.   G.Text(appleRastPort,ADR(ch),1);
  327.  END;
  328. END PutText;
  329.  
  330. VAR
  331.  appleScreen:i.ScreenPtr;
  332.  appleTextAttr:g.TextAttr;
  333.  blinkProcess,kbdProcess:d.ProcessPtr;
  334.  hasMenu:BOOLEAN;
  335.  oldWindow:i.WindowPtr;
  336.  proc:d.ProcessPtr;
  337.  tagbuf:ARRAY [0..19] OF LONGCARD;
  338.  trapHandler:PROC;
  339. BEGIN
  340. (*
  341.  Open screen and window.
  342. *)
  343.  appleTextAttr.name:=ADR(screenFont);
  344.  appleTextAttr.ySize:=8;
  345.  appleTextAttr.style:=g.FontStyleSet{};
  346.  appleTextAttr.flags:=g.FontFlagSet{};
  347.  appleScreen:=I.OpenScreenTagList(
  348.   NIL,TAG(
  349.    tagbuf,i.saDepth,5,i.saTitle,ADR(title),i.saPens,ADR(pens)
  350.    ,i.saDisplayID,g.loresKey,i.saColors,ADR(appleColors)
  351.    ,i.saFont,ADR(appleTextAttr)
  352. (*   ,i.saBlockPen,wb0,i.saDetailPen,wb1*)
  353.    ,u.tagDone
  354.   )
  355.  );
  356.  N(appleScreen,errNoScreen);
  357.  appleViewPort:=ADR(appleScreen^.viewPort);
  358.  appleWindow:=I.OpenWindowTagList(
  359.   NIL
  360.   ,TAG(
  361.    tagbuf,i.waScreenTitle,ADR(title),i.waCustomScreen,appleScreen
  362.    ,i.waTop,appleScreen^.barHeight+1,i.waHeight,appleScreen^.height-appleScreen^.barHeight-1
  363.    ,i.waBorderless,TRUE,i.waBackdrop,TRUE,i.waActivate,TRUE
  364.    ,i.waIDCMP,i.IDCMPFlagSet{} (* No IDCMP, as KBDProc has to open the port *)
  365.    ,u.tagDone
  366.   )
  367.  );
  368.  N(appleWindow,errNoWindow);
  369.  appleMenu:=ADR(appleMenu0);
  370.  hasMenu:=I.SetMenuStrip(appleWindow,appleMenu);
  371.  A(appleWindow^.width>=280,errWidth);
  372.  A(appleWindow^.height>=192,errHeight);
  373.  
  374.  appleRastPort:=appleWindow^.rPort;
  375.  
  376.  proc:=ADDRESS(E.FindTask(NIL));
  377.  oldWindow:=proc^.windowPtr;
  378.  proc^.windowPtr:=appleWindow;
  379.  trapHandler:=proc^.task.trapCode;
  380.  
  381. (*
  382.  Start process for blinking.
  383. *)
  384.  mainTask:=E.FindTask(NIL);
  385.  killBlinkReply:=E.AllocSignal(-1);
  386.  blinkProcess:=D.CreateNewProc(
  387.   TAG(tagbuf,d.npEntry,ADR(BlinkProc),d.npName,ADR(blinkName),u.tagDone)
  388.  );
  389.  blinkProcess^.task.trapCode:=trapHandler;
  390.  
  391.  killKBDReply:=E.AllocSignal(-1);
  392.  kbdProcess:=D.CreateNewProc(
  393.   TAG(tagbuf,
  394.    d.npEntry,ADR(KBDProc),d.npName,ADR(kbdName),d.npPriority,10,u.tagDone
  395.   )
  396.  );
  397.  kbdProcess^.task.trapCode:=trapHandler;
  398.  
  399. CLOSE
  400.  IF blinkProcess#NIL THEN
  401.   E.Signal(ADR(blinkProcess^.task),LONGSET{killBlink});
  402.   IF E.Wait(LONGSET{killBlinkReply})=LONGSET{} THEN END;
  403.  END;
  404.  IF kbdProcess#NIL THEN
  405.   E.Signal(ADR(kbdProcess^.task),LONGSET{killKBD});
  406.   IF E.Wait(LONGSET{killKBDReply})=LONGSET{} THEN END;
  407.  END;
  408.  E.FreeSignal(killBlinkReply);
  409. (*
  410.  NOTE: Close window only after KBDProc terminated.
  411. *)
  412.  proc^.windowPtr:=oldWindow;
  413.  IF appleWindow#NIL THEN
  414.   IF hasMenu THEN I.ClearMenuStrip(appleWindow); END;
  415.   I.CloseWindow(appleWindow); appleWindow:=NIL;
  416.  END;
  417.  IF appleScreen#NIL THEN I.CloseScreen(appleScreen); appleScreen:=NIL; END;
  418. END AppleScreen.
  419.