*************************************************** * WB-Beispielprogramm * * von Alexander Kochann und Oliver Reiff * * für mit DevPacII * * nur von der Shell starten * *************************************************** TAG_USER equ $80000000 opt a+,o+,p+ Start move.l 4.w,a6 lea IntName,a1 moveq #36,d0 * OS2.x oder höher jsr -552(a6) OpenLib lea IntBase,a0 move.l d0,(a0) beq No_OS2 * Kein OS2.x lea GfxName,a1 jsr -408(a6) OldOpenLib lea GfxBase,a0 move.l d0,(a0) lea GadName,a1 jsr -408(a6) OldOpenLib lea GadBase,a0 move.l d0,(a0) move.l IntBase,a6 lea PupScreen,a0 jsr -510(a6) LockPupScreen lea Screen,a0 move.l d0,(a0) beq No_Screen * Kein Screen move.l d0,a0 jsr -690(a6) GetScreenDrawInfo lea DrawInfo,a0 move.l d0,(a0) move.l d0,a1 move.l 8(a1),a1 lea Font,a0 move.l a1,(a0) * dri_Font lea YSize,a0 move.w 20(a1),(a0) * tf_YSize lea BaseLine,a0 move.w 26(a1),(a0) * tf_BaseLine move.w YSize,d0 lsl.w #1,d0 * mal 2 addq.w #8,d0 * plus 2 mal 4 Pixel lea WA_InnerHeight+6,a0 move.w d0,(a0) * Innere Höhe lea Text_1,a0 bsr GetTextLenght move.l d0,d1 * Pixelbreite Text 1 lea Text_2,a0 bsr GetTextLenght cmp.w d0,d1 * Welcher Text ist breiter ? blt.s .Width_Ok move.w d1,d0 .Width_Ok addq.w #8,d0 * plus 2 mal 4 Pixel lea WA_InnerWidth+6,a0 move.w d0,(a0) * Innere Breite move.l Screen,a1 lea WindowData,a0 move.b 30(a1),3(a0) * TopEdge addq.b #1,3(a0) lea WindowTags,a1 jsr -606(a6) OpenWindowTagList lea Window,a0 move.l d0,(a0) beq No_Window move.l d0,a1 lea RastPort,a0 move.l 50(a1),(a0) * RastPort des Fensters lea MessagePort,a0 move.l 86(a1),(a0) * MsgPort des Fensters move.l GadBase,a6 * Menu einrichten lea NewMenu,a0 lea NewMenuTags,a1 jsr -48(a6) CreateMenusA lea Menu,a0 move.l d0,(a0) beq No_Menu move.l Screen,a0 sub.l a1,a1 jsr -126(a6) GetVisualInfoA lea VisualInfo,a0 move.l d0,(a0) move.l Menu,a0 move.l VisualInfo,a1 lea NewMenuTags,a2 jsr -66(a6) LayoutMenusA tst.l d0 beq No_Layout move.l IntBase,a6 move.l Window,a0 move.l Menu,a1 jsr -264(a6) SetMenuStrip move.l Font,a0 * Font setzen und Text ausgeben move.l RastPort,a1 move.l GfxBase,a6 jsr -66(a6) SetFont move.l Window,a1 moveq #0,d0 * Text X-Pos moveq #0,d1 * Text Y-Pos move.b 54(a1),d0 * LeftBorder move.b 55(a1),d1 * TopBorder add.w BaseLine,d1 * plus Font Basislinie addq.w #4,d0 * plus 4 Pixel addq.w #4,d1 * plus 4 Pixel bsr Move move.l DrawInfo,a2 move.l 4(a2),a2 * dri_Pens move.w 16(a2),d2 * hilighttextPen bsr SetPen lea Text_1,a0 bsr PrintText * Text 1 hervorheben add.w YSize,d1 * Nächste Zeile bsr Move move.w 4(a2),d2 * textPen bsr SetPen lea Text_2,a0 bsr PrintText * Text 2 normal Wait move.l 4.w,a6 * Wait wegen Multitasking moveq #-1,d0 jsr -318(a6) Wait .NextMsg move.l MessagePort,a0 jsr -372(a6) GetMsg tst.l d0 * keine Message beq.s Wait move.l d0,a1 move.l 20(a1),d2 * kein Ereignis move.w 24(a1),d3 * Menupunkt jsr -378(a6) ReplyMsg cmp.l #$200,d2 * CloseGadget ? beq.s Ende cmp.l #$100,d2 * Menu ? bne.s .NextMsg cmp.b #$40,d3 * 3. Punkt im 1. Menu ? bne.s .NextMsg Ende moveq #0,d7 * Ok, kein Fehler Err_Layout move.l GadBase,a6 * Alles freigeben... move.l Menu,a0 jsr -54(a6) FreeMenus move.l VisualInfo,a0 jsr -132(a6) FreeVisualInfo Err_Menu move.l IntBase,a6 move.l Window,a0 jsr -72(a6) CloseWindow Err_Window move.l IntBase,a6 move.l Screen,a0 move.l DrawInfo,a1 jsr -696(a6) FreeDrawInfo sub.l a0,a0 move.l Screen,a1 jsr -516(a6) UnlockPubScreen Err_Screen move.l 4.w,a6 move.l GadBase,a1 jsr -414(a6) move.l GfxBase,a1 jsr -414(a6) move.l IntBase,a1 jsr -414(a6) Err_OS2 move.l d7,d0 * Fehlercode rts *------------------------------------------ * Hier sollten Sie alle auftretenden Fehler * abfangen und dem Benutzer mit Hilfe von * Requestern darauf hinweisen. Wir haben * darauf verzichtet, um das Programm nicht * unnötig zu verlängern. No_OS2 moveq #-10,d7 bra.s Err_OS2 No_Screen moveq #-10,d7 bra.s Err_Screen No_Window moveq #-10,d7 bra.s Err_Window No_Menu moveq #-10,d7 bra.s Err_Menu No_Layout moveq #-10,d7 bra.s Err_Layout *--------------------- GetTextLenght movem.l d1/a0-a2/a6,-(sp) move.l a0,a2 move.l Screen,a1 lea 84(a1),a1 * RastPort moveq #-1,d0 .loop addq.l #1,d0 tst.b (a2)+ bne.s .loop move.l GfxBase,a6 jsr -54(a6) TextLenght movem.l (sp)+,d1/a0-a2/a6 rts *--------------------- PrintText movem.l d0-d1/a0-a2/a6,-(sp) move.l a0,a2 move.l RastPort,a1 moveq #-1,d0 .loop addq.l #1,d0 tst.b (a2)+ bne.s .loop move.l GfxBase,a6 jsr -60(a6) Text movem.l (sp)+,d0-d1/a0-a2/a6 rts *--------------------- SetPen movem.l d0-d1/a0-a1/a6,-(sp) move.w d2,d0 move.l RastPort,a1 move.l GfxBase,a6 jsr -342(a6) SetAPen movem.l (sp)+,d0-d1/a0-a1/a6 rts *--------------------- Move movem.l d0-d1/a0-a1/a6,-(sp) move.l RastPort,a1 move.l GfxBase,a6 jsr -240(a6) Move movem.l (sp)+,d0-d1/a0-a1/a6 rts *------------------------------------------ opt p- IntBase dc.l 0 GfxBase dc.l 0 GadBase dc.l 0 RastPort dc.l 0 MessagePort dc.l 0 DrawInfo dc.l 0 VisualInfo dc.l 0 Font dc.l 0 Menu dc.l 0 Window dc.l 0 YSize dc.w 0 BaseLine dc.w 0 WindowData dc.w 0,0,0,0,1 dc.l $300,$2100f,0,0,WindowName Screen dc.l 0,0 dc.w 0,0,-1,-1,15 WindowTags dc.l TAG_USER+147,1 WA_InnerWidth dc.l TAG_USER+118,0 WA_InnerHeight dc.l TAG_USER+119,0 dc.l 0 NewMenu dc.b 1,0 dc.l MenuTitle_1,0 dc.w 0 dc.l 0,0 dc.b 2,0 dc.l MenuPoint_1,T_Key dc.w $109 dc.l 0,0 dc.b 2,0 dc.l -1,0 dc.w 0 dc.l 0,0 dc.b 2,0 dc.l MenuPoint_3,V_Key dc.w 0 dc.l 0,0 dc.l 0 NewMenuTags dc.l TAG_USER+$80043,1 dc.l 0 VersionString dc.b '$VER: WB-Beispielprogramm (11.11.92)',0 IntName dc.b 'intuition.library',0 GfxName dc.b 'graphics.library',0 GadName dc.b 'gadtools.library',0 PupScreen dc.b 'Workbench',0 WindowName dc.b 'Testfenster',0 MenuTitle_1 dc.b 'Projekt',0 MenuPoint_1 dc.b 'Test',0 MenuPoint_3 dc.b 'Verlassen',0 Text_1 dc.b 'Nicht vergessen:',0 Text_2 dc.b 'Die WB ist unberechenbar...',0 T_Key dc.b 'T',0 V_Key dc.b 'V',0 END