'
'   P O P U P
'
'   1990 by Alexander Golde
'   (c) MAXON/KICKSTART
'   GFA-BASIC 3.05 ...
'
prefs                                       ! Programmstart
main
'
PROCEDURE prefs                           ! Voreinstellungen
  OPENS 1,0,0,640,256,2,32768
  window|=1                               !  Wichtig !! Windownummer
  OPENW #window|,0,0,640,256,0,71688
  '
  COLOR 0
  PBOX 0,0,640,10
  '
  OPTION BASE 1                           ! Kein nulltes Array-Element
  '
  DEFWRD "a-z"
  '
  initpopup                               ! Wichtig !! Nicht vergessen
RETURN
'
PROCEDURE main                            ! Bsp. fr Aufruf
  REPEAT
    '
    REPEAT
      MOUSE x&,y&,but|
    UNTIL but|
    '
    IF but|=2
      popup_main             ! Aufruf PopUp
    ENDIF
    '
    PRINT AT(9,2);"Menunummer : ";menunummer|''
    PRINT AT(8,3);"Menueinrag : ";menueintrag|''
    PRINT AT(3,4);"Untermenueintrag : ";eintrag|''
    '
  UNTIL but|=1
RETURN
'
' --------------------------------------------------------------------------
'
PROCEDURE initpopup                       ! PopUp initialisieren
  haken:
  DATA 0,2,0,9,0,6,255,129,255,24
  DATA 254,64,124,232,57,192,147,192,199,192
  DATA 0,1,0,24,0,0,0,24,0,0
  DATA 0,0,0,0
  '
  RESTORE haken
  haken$=SPACE$(34)
  adr%=VARPTR(haken$)
  FOR i|=0 TO 33
    READ a&
    POKE adr%+i|,a&
  NEXT i|
  '
  popupdata:
  DATA Info\H0
  DATA PopUp\U4,1990 by Alexander Golde\UC,(c) by MAXON/KICKSTART\U4
  DATA Disk\H0
  DATA Laden\U0,Speichern\U0,L”schen\U0,"Speichern, A\U0"
  DATA Project\H0
  DATA New Names\U0,New\U0,Save Icon\U8,Taskpri\U0,Schreibmode\U0
  DATA Block\H0
  DATA Copy\U0,Move\U0,Write\U0,LList\U0,Start\U0,End\U0
  DATA Edit\H0
  DATA Insert\U8,Overwrite\U0,Page Up\U0,Page Down\U0,Normal\U0,Interlace\U0
  DATA ---------\H4
  DATA Merge\H0
  DATA Exit\H0
  DATA XXX
  '
  maxbreite&=0
  maxbreite1&=0
  maxh™he&=0
  '
  FOR init|=1 TO 2
    haupt|=0
    unter|=0
    '
    RESTORE popupdata
    DO
      READ menu$
      EXIT IF menu$="XXX"
      slashpos|=INSTR(menu$,"\")
      test$=MID$(menu$,slashpos|+1,1)
      opt$=MID$(menu$,slashpos|+2,1)
      take$=MID$(menu$,1,slashpos|-1)
     IF test$="H"
        INC haupt|
        IF init|=2
          haupt$(haupt|)=take$
          hauptopt$(haupt|)=opt$
          maxbreite&=MAX(maxbreite&,LEN(haupt$(haupt|))*8+30)
        ENDIF
      ELSE IF test$="U"
        INC unter|
        IF init|=2
          INC unter|(haupt|)
          unter$(unter|)=take$
          unteropt$(unter|)=opt$
          maxbreite&(haupt|)=MAX(maxbreite&(haupt|),LEN(take$)*8+30)
          maxbreite1&=MAX(maxbreite1&,maxbreite&(haupt|))
          maxh™he&(haupt|)=MAX(maxh™he&(haupt|),unter|(haupt|)*12+6)
        ENDIF
      ENDIF
    LOOP
    '
    IF init|=1
      DIM haupt$(haupt|+1),unter$(unter|+1),unter|(haupt|+1)
      DIM hauptopt$(haupt|+1),unteropt$(unter|+1)
      DIM maxbreite&(haupt|+1),maxh™he&(haupt|+1)
      max&=MAX(1,haupt|,unter|)
      DIM work$(max&),workopt$(max&)
    ENDIF
    '
  NEXT init|
  '
  maxh™he&=haupt|*12+6
  winx&=DPEEK(WINDOW(window|)+8)               ! Breite Window
  winy&=DPEEK(WINDOW(window|)+10)              ! H”he Window
RETURN
'
PROCEDURE popup_main                      ! Hauptmenu-Box
  LOCAL mx&,my&,ux&,uy&
  '
  SWAP work$(),haupt$()
  SWAP workopt$(),hauptopt$()
  '
  popup_main1:
  mx&=MAX(5,MIN(x&,winx&-maxbreite&-maxbreite1&-5))
  my&=MAX(5,MIN(y&,winy&-maxh™he&-5))
  '
  begin|=1
  work|=haupt|
  GET mx&,my&,mx&+maxbreite&,my&+maxh™he&,mbox$
  print_box(mx&,my&,maxbreite&,maxh™he&)
  '
  main$=""
  but|=0
  eintrag|=0
  menunummer|=0
  menueintrag|=0
  '
  REPEAT
  UNTIL MOUSEK=0
  '
  REPEAT
    again:
    REPEAT
      MOUSE x&,y&,but|
      row|=MAX(0,MIN((y&-my&+8)/12,haupt|+1,255))
    UNTIL OR(OR(but|,row|<>orow|),OR(x&<mx&,x&>mx&+maxbreite&))
    '
    EXIT IF but|=2
    '
    IF OR(OR(OR(row|<1,row|>haupt|),x&<mx&),x&>mx&+maxbreite&)
      again2:
      PUT mx&+7,my&+orow|*12-7,main$,&H50
      main$=""
      orow|=0
      IF but|=1
        schieber
        GOTO popup_main1
      ENDIF
      GOTO again
    ENDIF
    '
    opt$=workopt$(MAX(1row|))
    IF OR(OR(OR(OR(opt$="4",opt$="6"),opt$="C"),opt$="E"),opt$="5")
      GOTO again2
    ENDIF
    '
    PUT mx&+7,my&+orow|*12-7,main$,&H50
    GET mx&+7,my&+row|*12-7,maxbreite&+mx&-20,my&+row|*12+1,main$
    PUT mx&+7,my&+row|*12-7,main$,&H50
    '
    IF unter|(row|)>0
      popup_sub(mx&+maxbreite&+5,MIN(my&+row|*12-12,winy&-maxh™he&(row|)-5))
    ELSE
      orow|=row|
    ENDIF
    '
    IF AND(AND(but|=1,unter|(row|)=0),workopt$(row|)<>"4")
      menunummer|=row|
    ENDIF
    '
  UNTIL OR(but|=2,OR(menunummer|,menueintrag|))
  '
  but|=0
  SWAP workopt$(),hauptopt$()
  SWAP work$(),haupt$()
  PUT mx&,my&,mbox$
  '
  REPEAT
  UNTIL MOUSEK=0
RETURN
'
PROCEDURE print_box(x&,&,mbreite&,mh™he&)    ! Box zeichnen
  COLOR 1,0
  PBOX x&,y&,x&+mbreite&,y&+mh™he&
  COLOR 0,1
  BOX x&+2,y&+1,x&+mbreite&-2,y&+mh™he&-1
  BOX x&+3,y&+1,x&+mbreite&-3,y&+mh™he&-1
  '
  FOR i|=begin| TO work|
    ypos&=y&+(i|-begin|+1)*12
    COLOR 0,1
    '
    opt$=workopt$(i|)
    IF OR(OR(OR(opt$="0",opt$="4"),opt$="8"),opt$="C")
      GRAPHMODE 1
      TEXT x&+9,ypos&,work$(i|)
    ENDIF
    IF OR(OR(opt$="1",opt$="9"),opt$="5")
      GRAPHMODE 2
      PBOX x&+6,ypos&-8,mbreite&+x&-19,ypos&+2
      TEXT x&+9,ypos&,work$(i|)
    ENDIF
    IF OR(OR(OR(opt$="2",opt$="6"),opt$="A"),opt$="E")
      GRAPHMODE 1
      BOX x&+6,ypos&-8,mbreite&+x&-19,ypos&+2
      TEXT x&+9,ypos&,work$(i|)
    ENDIF
    IF OR(OR(OR(OR(opt$="8",opt$="9"),opt$="A"),opt$="C"),opt$="E")
      GRAPHMODE 1
      PUT x&+mbreite&-16,ypos&-6,haken$
    ENDIF
    '
  NEXT i|
RETURN
'
PROCEDURE popup_sub(ux&,uy&)                ! UntermenŬ-Box
  orow|=row|
  SWAP workopt$(),hauptopt$()
  SWAP work$(),haupt$()
  SWAP work$(),unter$()
  SWAP workopt$(),unteropt$()
  '
  begin|=1
  FOR i|=1 TO row|
    ADD begin|,unter|(i|)
  NEXT i|
  SUB begin|,unter|(row|)
  work|=begin|+unter|(row|)-1
  '
  GET ux&,uy&,ux&+maxbreite&(row|),uy&+maxh™he&(row|),ubox$  ! Hintergrund retten
  '
  print_box(ux&,uy&,maxbreite&(row|),maxh™he&(row|))   ! Untermenu-Box zeichnen
  '
  orow1|=0
  main1$=""
  REPEAT
    '
    popup_sub1:
    MOUSE x&,y&,but|
    row1|=MAX(0,MIN((y&-uy&+8)/12,unter|(row|)+1,255))
    '
    EXIT IF OR(AND(AND(x&>mx&,x&<mx&+maxbreite&),OR(y&<my&+row|*12-12,y&>my&+row|*12+4)),but|=2)
    '
    EXIT IF AND(OR(OR(x&<mx&,x&>ux&+maxbreite&(row|)),OR(y&<my&,y&>uy&+maxh™he&(row|))),but|=1)
    '
    IF OR(x&<ux&,x&>ux&+maxbreite&(row|))
      GOTO popup_sub2
    ENDIF
    '
    IF OR(y&<uy&,y&>uy&+maxh™he&(row|))
      GOTO popup_sub2
    ENDIF
    '
    IF OR(row1|<1,row1|>unter|(row|))
      popup_sub2:
      but|=0
      PUT ux&+7,uy&+orow1|*12-7,main1$,&H50
      main1$=""
      orow1|=0
      GOTO popup_sub1
    ENDIF
    '
    opt$=workopt$(begin|+row1|-1)
    IF OR(OR(OR(OR(opt$="4",opt$="6"),opt$="C"),opt$="E"),opt$="5")
      GOTO popup_sub2
    ENDIF
    '
    IF AND(x&>ux&,row1|<>orow1|)
      PUT ux&+7,uy&+orow1|*12-7,main1$,&H50
      GET ux&+7,uy&+row1|*12-7,maxbreite&(row|)+ux&-20,uy&+row1|*12+1,main1$
      PUT ux&+7,uy&+row1|*12-7,main1$,&H50
      orow1|=row1|
    ENDIF
    '
  UNTIL AND(but|=1,AND(x&>ux&,x&<ux&+maxbreite&(row|)))
  '
  IF AND(but|=1,AND(x&>ux&,x&<ux&+maxbreite&(row|)))
    menunummer|=row|
    menueintrag|=row1|
    eintrag|=begin|+menueintrag|-1
    but|=0
  ENDIF
  '
  PUT ux&,uy&,ubox$
  SWAP workopt$(),unteropt$()
  SWAP work$(),unter$()
  SWAP work$(),haupt$()
  SWAP workopt$(),hauptopt$()
RETURN
'
PROCEDURE schieber                        ! Menubox verschieben
  PUT mx&,my&,mbox$
  mbox$=""
  COLOR 1
  '
  REPEAT
    '
    REPEAT
      MOUSE x&,y&,but|
      mx&=MAX(5,MIN(x&,winx&-maxbreite&-maxbreite1&-5))
      my&=MAX(5,MIN(y&,winy&-maxh™he&-5))
    UNTIL OR(OR(omx&<>mx&,omy&<>my&),but|<>1)
    '
    PUT omx&,omy&,mbox$
    omx&=mx&
    omy&=my&
    GET mx&,my&,mx&+maxbreite&,my&+maxh™he&,mbox$
    BOX mx&,my&,mx&+maxbreite&,my&+maxh™he&
    '
  UNTIL but|<>1
  PUT mx&,my&,mbox$
RETURN