* WB-Beispielprogramm für DevPac II

TAG_USER   equ        $80000000
    opt        a+,o+,p+
Start move.l     4.w,a6
    lea        IntName,a1
    * OS 2.0 oder höher
    moveq      #37,d0
    jsr        -552(a6)
    lea        IntBase,a0
    move.l     d0,(a0)
    * Kein OS 2.x
    beq        No_OS2
    lea        GfxName,a1
    * jsr OldOpenLib
    jsr        -408(a6)
    lea        GfxBase,a0
    move.l     d0,(a0)
    lea        GadName,a1
    * jsr OldOpenLib
    jsr        -408(a6)
    lea        GadBase,a0
    move.l     d0,(a0)
    move.l     IntBase,a6
    lea        PupScreen,a0
    * LockPupScreen
    jsr        -510(a6)
    lea        Screen,a0
    move.l     d0,(a0)
    * Kein Screen
    beq        No_Screen
    move.l     d0,a0
    * GetScreenDrawInfo
    jsr        -690(a6)
    lea        DrawInfo,a0
    move.l     d0,(a0)
    move.l     d0,a1
    move.l     8(a1),a1
    lea        Font,a0
    * dri_Font
    move.l     a1,(a0)
    lea        YSize,a0
    * tf_YSize
    move.w     20(a1),(a0)
    lea        BaseLine,a0
    * tf_BaseLine
    move.w     26(a1),(a0)
    move.w     YSize,d0
    lsl.w      #1,d0
    addq.w     #8,d0
    lea        WA_InnerHeight+6,a0
    * Innere Höhe
    move.w     d0,(a0)
    lea        Text_1,a0
    bsr        GetTextLenght
    * Pixelbreite Text 1
    move.l     d0,d1
    lea        Text_2,a0
    bsr        GetTextLenght
    * Welcher Text ist breiter ?
    cmp.w      d0,d1
    blt.s      .Width_Ok
    move.w     d1,d0
.Width_Ok  addq.w     #8,d0
    lea        WA_InnerWidth+6,a0
    * Innere Breite
    move.w     d0,(a0)
    move.l     Screen,a1
    lea        WindowData,a0
    * TopEdge
    move.b     30(a1),3(a0)
    addq.b     #1,3(a0)
    lea        WindowTags,a1
    * OpenWindowTagList
    jsr        -606(a6)
    lea        Window,a0
    move.l     d0,(a0)
    beq        No_Window
    move.l     d0,a1
    lea        RastPort,a0
    * RastPort des Fensters
    move.l     50(a1),(a0)
    lea        MessagePort,a0
    * MsgPort des Fensters
    move.l     86(a1),(a0)
    * Menü einrichten
    move.l     GadBase,a6
    lea        NewMenu,a0
    lea        NewMenuTags,a1
    * CreateMenusA
    jsr        -48(a6)
    lea        Menu,a0
    move.l     d0,(a0)
    beq        No_Menu
    move.l     Screen,a0
    sub.l      a1,a1
    * GetVisualInfoA
    jsr        -126(a6)
    lea        VisualInfo,a0
    move.l     d0,(a0)
    move.l     Menu,a0
    move.l     VisualInfo,a1
    lea        NewMenuTags,a2
    * LayoutMenusA
    jsr        -66(a6)
    tst.l      d0
    beq        No_Layout
    move.l     IntBase,a6
    move.l     Window,a0
    move.l     Menu,a1
    * SetMenuStrip
    jsr        -264(a6)
    * Font setzen und Text ausgeben
    move.l     Font,a0
    move.l     RastPort,a1
    move.l     GfxBase,a6
    * SetFont
    jsr        -66(a6)
    move.l     Window,a1
    * Text X-Pos, Y-Pos
    moveq      #0,d0
    moveq      #0,d1
    * LeftBorder, TopBorder
    move.b     54(a1),d0
    move.b     55(a1),d1
    * plus Font Basislinie
    add.w      BaseLine,d1
    * plus 2 x 4 Pixel
    addq.w     #4,d0
    addq.w     #4,d1
    bsr        Move
    move.l     DrawInfo,a2
    * dri_Pens
    move.l     4(a2),a2
    * hilighttextPen
    move.w     16(a2),d2
    bsr        SetPen
    lea        Text_1,a0
    bsr        PrintText
    add.w      YSize,d1
    bsr        Move
    move.w     4(a2),d2
    bsr        SetPen
    lea        Text_2,a0
    bsr        PrintText
Wait       move.l     4.w,a6
    * Wait wegen Multitasking
    moveq      #-1,d0
    jsr        -318(a6)
.NextMsg
    move.l     MessagePort,a0
    jsr        -372(a6)
    tst.l      d0
    beq.s      Wait
    move.l     d0,a1
    move.l     20(a1),d2
    move.w     24(a1),d3
    jsr        -378(a6)
    * CloseGadget ?
    cmp.l      #$200,d2
    beq.s      Ende
    * Menu ?
    cmp.l      #$100,d2
    bne.s      .NextMsg
    * 3. Punkt im 1. Menu ?
    cmp.b      #$40,d3
    bne.s      .NextMsg
Ende
    * Ok, kein Fehler
    moveq      #0,d7
Err_Layout
    * Alles freigeben...
    move.l     GadBase,a6
    move.l     Menu,a0
    jsr        -54(a6)
    move.l     VisualInfo,a0
    * FreeVisualInfo
    jsr        -132(a6)
Err_Menu   move.l     IntBase,a6
    move.l     Window,a0
    jsr        -72(a6)
Err_Window move.l     IntBase,a6
    move.l     Screen,a0
    move.l     DrawInfo,a1
    * FreeDrawInfo
    jsr        -696(a6)
    sub.l      a0,a0
    move.l     Screen,a1
    * UnlockPubScreen
    jsr        -516(a6)
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
*-------------------------------
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
    * RastPort
    lea        84(a1),a1
    moveq      #-1,d0
.loop      addq.l     #1,d0
    tst.b      (a2)+
    bne.s      .loop
    move.l     GfxBase,a6
    * TextLenght
    jsr        -54(a6)
    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
    * Text
    jsr        -60(a6)
    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
    * SetAPen
    jsr        -342(a6)
    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
    * Move
    jsr        -240(a6)
    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,
              dc.l    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,0
NewMenuTags   dc.l    TAG_USER+$80043,1
              dc.l    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