' IDCMPWindow

' Open a window connected to the WorkBench using exec and intuition commands
' and the structure subprograms to set up a NewWindow structure.  Close 
' using IDCMP system to examine system close gadget.
     
  DEFLNG a-Z ' Everything is LONG (4 bytes) unless otherwise specified.
 
  LIBRARY "exec.library"
    DECLARE FUNCTION AllocMem() LIBRARY
  LIBRARY "intuition.library"
    DECLARE FUNCTION OpenWindow() LIBRARY
    DECLARE FUNCTION WaitPort() LIBRARY
    DECLARE FUNCTION GetMsg() LIBRARY
         
  WINDOW CLOSE 1 ' get rid of AmigaBASIC default window

  STRUCT NewWindow,48&,"ClrPubFAST"

    IF NewWindow = 0 THEN ' allocation failed!
      BEEP
      SYSTEM
    END IF

    WORD  200&                          ' LeftEdge 
    WORD  200&                          ' TopEdge 
    WORD  240&                          ' Width
    WORD   50&                          ' Height
    BYTE    0&                          ' DetailPen
    BYTE    1&                          ' BlockPen
    LONG  512&                          ' IDCMPFlags
    LONG 1039&                          ' Flags
    LONG    0&                          ' Gadget
    LONG    0&                          ' Image
    SPTR "Quit With Gadget"             ' Title  
    LONG    0&                          ' WScreen
    LONG    0&                          ' BitMap
    WORD  100&                          ' MinWidth
    WORD   25&                          ' MinHeight
    WORD  350&                          ' MaxWidth
    WORD  150&                          ' MaxHeight
    WORD    1&                          ' Type      

  MyWindow = OpenWindow(NewWindow)
  
  FreeMem NewWindow,48& ' once a window is opened, the NewWindow structure
                        ' can be deallocated (always deallocate unused RAM!)


  IF MyWindow = 0 THEN ' open failed!
    BEEP
    SYSTEM
  END IF
     
  UserPort = PEEKL(MyWindow+86)  ' address of user message port
  
  CloseMe = 0       ' 0 = FALSE, and -1 = TRUE in AmigaBASIC

  WHILE NOT CloseMe ' wait in loop until get message to close window
  
WaitAgain:
 
    MyMessage = WaitPort(UserPort)  ' sleep until get message from UserPort
  
GetNextMsg:

    MyMessage = GetMsg(UserPort)    ' remove received message from queue
  
    IF MyMessage = 0 THEN GOTO WaitAgain  ' no more messages queued    

    MyClass = PEEKL(MyMessage+20) ' examine message
    
    ReplyMsg MyMessage            ' reply to the message after examine it

    IF MyClass = 512 THEN
      CloseMe = -1
    ELSE
      GOTO GetNextMsg  ' make sure there are no other messages queued
    END IF
       
  WEND

  CloseWindow MyWindow ' close the window (deallocates Window structure)

  LIBRARY CLOSE

  SYSTEM 
 
'****** Structure SubPrograms:

  SUB STRUCT(StrctName&,StrctSize&,MemType$) STATIC
  SHARED NextStrctAdrs&
    MemfPublic  =    1&
    MemfChip    =    2&
    MemfFast    =    4&
    MemfClear   = 65536&
    Type$ = UCASE$(MemType$)
    IF Type$ = "CLRPUBFAST" THEN MemType&=MemfClear+MemfPublic+MemfFast
    IF Type$ = "CLRPUBCHIP" THEN MemType&=MemfClear+MemfPublic+MemfChip
    IF Type$ = "PUBFAST" THEN MemType& = MemfPublic + MemfFast
    IF Type$ = "PUBCHIP" THEN MemType& = MemfPublic + MemfFast
    IF Type$ = "CLRFAST" THEN MemType& = MemfClear + MemfFast
    IF Type$ = "CLRCHIP" THEN MemType& = MemfClear + MemfChip
    StrctName& = AllocMem(StrctSize&,MemType&)
    NextStrctAdrs& = StrctName&
  END SUB

  SUB BYTE(ByteVal&) STATIC
  SHARED NextStrctAdrs&
    POKE NextStrctAdrs&,ByteVal&
    NextStrctAdrs& = NextStrctAdrs& + 1&
  END SUB

  SUB WORD(ShortVal&) STATIC
  SHARED NextStrctAdrs&
    POKEW  NextStrctAdrs&,ShortVal&
    NextStrctAdrs& = NextStrctAdrs& + 2&
  END SUB

  SUB LONG(LongVal&) STATIC
  SHARED NextStrctAdrs&
    POKEL NextStrctAdrs&, LongVal& 
    NextStrctAdrs& = NextStrctAdrs& + 4&
  END SUB
 
  SUB SPTR(Text$) STATIC
  SHARED NextStrctAdrs&
    Text$ = Text$ + CHR$(0)
    Text = SADD(Text$)
    LONG Text
  END SUB