home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 4 / AACD04.ISO / AACD / Programming / lsEstuff / gle.e < prev    next >
Encoding:
Text File  |  1999-10-28  |  10.5 KB  |  421 lines
  1. OPT MODULE
  2. /* 990719 FINALLY :) made it a class !! ..990804 */
  3.  
  4. /* very nice class if u dont like GUIengines
  5.    that place the gads by them self. much/easy
  6.    control over the layout.
  7.    It just builds up a gadgetlist!
  8.    No resizeing or such stuff!
  9.    Its automatically font sensitive!
  10. */
  11.  
  12. MODULE 'intuition/screens', 'gadtools', 'libraries/gadtools',
  13.        'intuition/intuition', 'utility', 'utility/tagitem'
  14.  
  15. EXPORT CONST GLE_SPACEXY=-10, ->[spacex,spacey]
  16.       GLE_GADFLAGS=-20,  ->flags
  17.       GLE_UNITFACTORXY=-30, ->[hpix,vpix]
  18.       GLE_MUP=-40, -> steps in units
  19.       GLE_MDOWN=-50,  ->steps   -"-
  20.       GLE_MLEFT=-60,  ->steps   -""-
  21.       GLE_MRIGHT=-70, ->steps   -""-
  22.       GLE_ADDGAD=-90, -> id
  23.       GLE_SETGUISTARTXY=-110, ->[x,y]
  24.       GLE_PLACE=-130, ->[h,v]
  25.       GLE_PLACEXY=-140, ->[x,y]
  26.       GLE_MSX=-150, -> NIL
  27.       GLE_MSY=-160, -> NIL
  28.       GLE_GADTEXTATTR=-170, ->textattr
  29.       GLE_PLACING=-255,
  30.       GP_RIGHT=-260,
  31.       GP_UNDER=-270
  32.  
  33.  
  34. EXPORT OBJECT gle ->buildgadgetlist - data
  35.    PRIVATE
  36.    glist:PTR TO gadget      -> hämta med getglist(gle)
  37.    gpa:PTR TO LONG     ->adress till array av gadpekare.
  38.    gadptr:PTR TO gadget
  39.    newgad:newgadget
  40.    ->-------------
  41.    unitfactorx:INT  ->sizefactor  h-unitsize
  42.    unitfactory:INT ->sizefactor  v-unitsize
  43.    gui_startx:INT  -> övre vänstra hörent
  44.    gui_starty:INT  -> att sätta första gaden.
  45.    gui_maxx:INT       -> nedre högra hörnet
  46.    gui_maxy:INT       -> på hela GUI:et.
  47.    cp_x:INT        -> nedre högra hörnet på senaste
  48.    cp_y:INT        -> gaden. eller om den sätts till
  49.                    -> nåt annat av PlacePix() eller
  50.                    ->tableft/tabup! bla..
  51.  
  52.    spacex:CHAR     -> mellanrum mellan gadgets vertikalt
  53.    spacey:CHAR     ->         (i pixels)       horisontellt
  54.    ->gadkind:LONG ->the usual..
  55.    ->gadtags:LONG
  56.    gadplacing:INT ->GP_RIGHT, GP_UNDER
  57.    error:LONG
  58. ENDOBJECT
  59.  
  60. DEF utilitybase, gadtoolsbase
  61.  
  62. ENUM ER_NONE, ER_VINFO, ER_CCT, ER_UTILLIB, ER_GTLIB
  63.  
  64.  
  65. RAISE ER_VINFO IF GetVisualInfoA()=NIL,
  66.       ER_CCT IF CreateContext()=NIL
  67.  
  68.  
  69. PROC gle(screen, gpa) OF gle  HANDLE
  70.    DEF glist=NIL
  71.    utilitybase:=OpenLibrary('utility.library', 37)
  72.    IF utilitybase=NIL THEN Raise(ER_UTILLIB)
  73.    gadtoolsbase:=OpenLibrary('gadtools.library', 37)
  74.    IF gadtoolsbase=NIL THEN Raise(ER_GTLIB)
  75.    self.newgad.visualinfo:=GetVisualInfoA(screen,NIL)
  76.    self.gadptr:=CreateContext({glist})
  77.    self.glist:=glist
  78.    self.gpa:=gpa
  79. EXCEPT
  80. SELECT exception
  81. CASE ER_VINFO
  82.    RETURN 'GetVisualInfo()'
  83. CASE ER_CCT
  84.    RETURN 'CreateContext()'
  85. CASE ER_UTILLIB
  86.    RETURN 'utility.library'
  87. CASE ER_GTLIB
  88.    RETURN 'gadtools.library'
  89. ENDSELECT
  90. self.end()
  91. ENDPROC NIL
  92.  
  93. PROC end() OF gle
  94.    IF self.newgad.visualinfo THEN FreeVisualInfo(self.newgad.visualinfo)
  95.    IF self.glist THEN FreeGadgets(self.glist)
  96.    IF utilitybase THEN CloseLibrary(utilitybase)
  97.    IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  98. ENDPROC
  99.  
  100.  
  101. PROC spaceXY(xspace, yspace) OF gle
  102.    self.spacex:=xspace
  103.    self.spacey:=yspace
  104. ENDPROC xspace, yspace
  105.  
  106. PROC unitFactorXY(xval, yval) OF gle
  107.    self.unitfactorx:=xval
  108.    self.unitfactory:=yval
  109. ENDPROC xval, yval
  110.  
  111. PROC mSX() OF gle
  112.    self.cp_x:=self.gui_startx
  113. ENDPROC self.cp_x
  114.  
  115. PROC mSY() OF gle
  116.    self.cp_y:=self.gui_starty
  117. ENDPROC self.cp_y
  118.  
  119. PROC mDown(units) OF gle
  120.    self.cp_y:=(self.cp_y)+(units*self.unitfactory)+(units*self.spacey)
  121. ENDPROC self.cp_y
  122.  
  123. PROC mRight(units) OF gle
  124.    self.cp_x:=(self.cp_x)+(units*self.unitfactorx)+(units*self.spacex)
  125. ENDPROC self.cp_x
  126.  
  127. PROC mUp(units) OF gle
  128.    self.cp_y:=(self.cp_y)-(units*self.unitfactory)-(units*self.spacey)
  129. ENDPROC self.cp_y
  130.  
  131. PROC mLeft(units) OF gle
  132.    self.cp_x:=(self.cp_x)-(units*self.unitfactorx)-(units*self.spacex)
  133. ENDPROC self.cp_x
  134.  
  135.  
  136. PROC setGUIStartXY(x, y) OF gle
  137.    self.gui_startx:=x
  138.    self.gui_starty:=y
  139. ENDPROC x, y
  140.  
  141. PROC addGad(kind, id, hsize, vsize, text, tags) OF gle
  142.    self.newgad.gadgetid:=id
  143.    self.newgad.width:=(hsize*self.unitfactorx)+((hsize-1)*self.spacex)
  144.    self.newgad.height:=(vsize*self.unitfactory)+((vsize-1)*self.spacey)
  145.    self.newgad.leftedge:=self.cp_x
  146.    self.newgad.topedge:=self.cp_y
  147.    self.newgad.gadgettext:=text
  148.    self.gadptr:=CreateGadgetA(kind, self.gadptr,
  149.                              self.newgad,tags)
  150.    self.cp_x:=(self.cp_x)+(self.newgad.width)+self.spacex
  151.    self.cp_y:=(self.cp_y)+(self.newgad.height)+self.spacey
  152.    self.gui_maxx:=Max(self.cp_x, self.gui_maxx)
  153.    self.gui_maxy:=Max(self.cp_y, self.gui_maxy)
  154.    IF self.gpa<>NIL THEN self.gpa[id]:=self.gadptr
  155.    self.gadptr.userdata:=kind ->990526
  156.    IF (self.gadplacing = GP_RIGHT) THEN self.mUp(vsize)
  157.    IF (self.gadplacing = GP_UNDER) THEN self.mLeft(hsize)
  158. ENDPROC self.gadptr
  159.  
  160.  
  161. PROC getCpX() OF gle IS self.cp_x
  162.  
  163. PROC getCpY() OF gle IS self.cp_y
  164.  
  165. PROC getMaxX() OF gle IS self.gui_maxx
  166.  
  167. PROC getMaxY() OF gle IS self.gui_maxy
  168.  
  169. PROC gadTextAttr(textattr) OF gle
  170.    self.newgad.textattr:=textattr
  171. ENDPROC
  172.  
  173. PROC getGList() OF gle IS self.glist
  174.  
  175. ->added 990523-----------------------
  176.  
  177. PROC gadFlags(flags) OF gle
  178.    self.newgad.flags:=flags
  179. ENDPROC
  180.  
  181. EXPORT PROC pixPerChar(screen:PTR TO screen)
  182.    DEF testtext, pixperchar
  183.    testtext:='abcdefghijklmnopqrstuvwxyzåäö' +
  184.              'ABCDEFGHIJKLMNOPQRSTUVWXYZÅÄÖ' +
  185.              '123456789'
  186.    pixperchar:=TextLength(screen.rastport,testtext,67)
  187.    pixperchar:=pixperchar/60
  188. ENDPROC pixperchar
  189.  
  190. EXPORT PROC copyIMessage(msg:PTR TO intuimessage, imsgcpy:PTR TO intuimessage)
  191.    imsgcpy.code:=msg.code
  192.    imsgcpy.qualifier:=msg.qualifier
  193.    imsgcpy.iaddress:=msg.iaddress
  194.    imsgcpy.class:=msg.class
  195.    imsgcpy.mousex:=msg.mousex
  196.    imsgcpy.mousey:=msg.mousey
  197. ENDPROC
  198.  
  199. PROC getWinInnerWidth(wnd:PTR TO window) OF gle
  200.    DEF iw
  201.    iw:=wnd.width
  202.    iw:=iw - wnd.borderleft
  203.    iw:=iw - wnd.borderright
  204.    iw:=iw - ((self.spacex) * 2)
  205. ENDPROC iw
  206.  
  207. PROC getWinInnerHeight(wnd:PTR TO window) OF gle
  208.    DEF ih
  209.    ih:=wnd.height
  210.    ih:=ih - wnd.bordertop
  211.    ih:=ih - wnd.borderbottom
  212.    ih:=ih - ((self.spacey) * 2)
  213. ENDPROC ih
  214.  
  215. PROC sniffWin(wnd:PTR TO window) OF gle
  216.    self.setGUIStartXY((self.spacex) + wnd.borderleft,
  217.                        (self.spacey) + wnd.bordertop)
  218. ENDPROC
  219.  
  220. /* du your gadgetcreations here..*/
  221. /* addgad,,bla,,etc... */
  222.  
  223. PROC finWin(wnd:PTR TO window) OF gle
  224.    DEF width, height
  225.    width:=self.getMaxX() + (self.spacex) + wnd.borderright
  226.    height:=self.getMaxY() + (self.spacey) + wnd.borderbottom
  227.    ChangeWindowBox(wnd, wnd.leftedge,
  228.                         wnd.topedge,
  229.                         width, height)
  230.    Delay(5)
  231.    AddGList(wnd, self.getGList(), -1, -1, NIL)
  232.    RefreshGList(self.getGList(), wnd, NIL, -1)
  233.    Gt_RefreshWindow(wnd, NIL)
  234. ENDPROC
  235.  
  236.  
  237. PROC place(xunit, yunit) OF gle
  238.    self.mSX()
  239.    self.mSY()
  240.    self.mRight(xunit)
  241.    self.mDown(yunit)
  242. ENDPROC
  243.  
  244. /* These two has nothing to do with gad creation.. */
  245. /* just nice to have when ya wanna get/set gadgets later.. */
  246. EXPORT PROC setGad(gad:PTR TO gadget, wnd, attr)
  247.    DEF kind, tag
  248.    kind:=gad.userdata
  249.    SELECT kind
  250.    CASE CHECKBOX_KIND
  251.       tag:=GTCB_CHECKED
  252.    CASE CYCLE_KIND
  253.       tag:=GTCY_ACTIVE
  254.    CASE INTEGER_KIND
  255.       tag:=GTIN_NUMBER
  256.    CASE LISTVIEW_KIND
  257.       tag:=GTLV_SELECTED 
  258.    CASE MX_KIND
  259.       tag:=GTMX_ACTIVE
  260.    CASE NUMBER_KIND
  261.       tag:=GTNM_NUMBER
  262.    CASE PALETTE_KIND
  263.       tag:=GTPA_COLOR
  264.    CASE SCROLLER_KIND
  265.       tag:=GTSC_VISIBLE
  266.    CASE SLIDER_KIND
  267.       tag:=GTSL_LEVEL
  268.    CASE STRING_KIND
  269.       tag:=GTST_STRING
  270.    CASE TEXT_KIND
  271.       tag:=GTTX_TEXT
  272.    ENDSELECT
  273.    Gt_SetGadgetAttrsA(gad, wnd, NIL, [tag, attr, NIL])
  274. ENDPROC attr
  275.  
  276. EXPORT PROC getGad(gad:PTR TO gadget, wnd)
  277.    DEF kind, attr, tag
  278.    kind:=gad.userdata
  279.    SELECT kind
  280.    CASE CHECKBOX_KIND
  281.       tag:=GTCB_CHECKED
  282.    CASE CYCLE_KIND
  283.       tag:=GTCY_ACTIVE
  284.    CASE INTEGER_KIND
  285.       tag:=GTIN_NUMBER
  286.    CASE LISTVIEW_KIND
  287.       tag:=GTLV_SELECTED
  288.    CASE MX_KIND
  289.       tag:=GTMX_ACTIVE
  290.    CASE NUMBER_KIND
  291.       tag:=GTNM_NUMBER
  292.    CASE PALETTE_KIND
  293.       tag:=GTPA_COLOR
  294.    CASE SCROLLER_KIND
  295.       tag:=GTSC_VISIBLE
  296.    CASE SLIDER_KIND
  297.       tag:=GTSL_LEVEL
  298.    CASE STRING_KIND
  299.       tag:=GTST_STRING
  300.    CASE TEXT_KIND
  301.       tag:=GTTX_TEXT
  302.    ENDSELECT
  303.    Gt_GetGadgetAttrsA(gad, wnd, NIL, [tag, {attr}, NIL])
  304. ENDPROC attr
  305.  
  306.  
  307.  
  308. PROC placeXY(x, y) OF gle
  309.    self.cp_x:=(self.gui_startx) + x
  310.    self.cp_y:=(self.gui_starty) + y
  311. ENDPROC
  312.  
  313.  
  314. /* the biggie... */
  315.  
  316. PROC buildA(tags) OF gle
  317.    DEF tag:PTR TO tagitem, ti_tag, lptr:PTR TO LONG, ti_data
  318.    WHILE (tag:=NextTagItem({tags}) )
  319.       ti_tag:=tag.tag
  320.       ti_data:=tag.data
  321.       SELECT ti_tag
  322.       CASE GLE_SPACEXY
  323.          lptr:=ti_data
  324.          self.spaceXY(lptr[0], lptr[1])
  325.       CASE GLE_GADFLAGS
  326.          self.gadFlags(ti_data)
  327.       CASE GLE_UNITFACTORXY
  328.          lptr:=ti_data
  329.          self.unitFactorXY(lptr[0], lptr[1])
  330.       CASE GLE_MUP
  331.          self.mUp(ti_data)
  332.       CASE GLE_MDOWN
  333.          self.mDown(ti_data)
  334.       CASE GLE_MLEFT
  335.          self.mLeft(ti_data)
  336.       CASE GLE_MRIGHT
  337.          self.mRight(ti_data)
  338.       CASE GLE_ADDGAD
  339.          lptr:=ti_data
  340.          self.addGad(lptr[0], lptr[1], lptr[2],
  341.                          lptr[3], lptr[4], lptr[5])
  342.       CASE GLE_SETGUISTARTXY
  343.          lptr:=ti_data
  344.          self.setGUIStartXY(lptr[0], lptr[1])
  345.       CASE GLE_PLACE
  346.          lptr:=ti_data
  347.          self.place(lptr[0], lptr[1])
  348.       CASE GLE_PLACEXY
  349.          lptr:=ti_data
  350.          self.placeXY(lptr[0], lptr[1])
  351.       CASE GLE_MSX
  352.          self.mSX()
  353.       CASE GLE_MSY
  354.          self.mSY()
  355.       CASE GLE_GADTEXTATTR
  356.          self.gadTextAttr(ti_data)
  357.       CASE GLE_PLACING
  358.          self.placing(ti_data)
  359.       ENDSELECT
  360.    ENDWHILE
  361. ENDPROC
  362.  
  363. PROC placing(placing) OF gle
  364.    self.gadplacing:=placing
  365. ENDPROC
  366.  
  367.  
  368. EXPORT PROC findGad(glist:PTR TO gadget, id)
  369.    DEF first:PTR TO gadget
  370.    first:=glist.nextgadget
  371.    WHILE first <> NIL
  372.       IF first.gadgetid = id THEN RETURN first
  373.       first := first.nextgadget
  374.    ENDWHILE
  375. ENDPROC NIL
  376.  
  377. /* Swedish Doc...
  378.  
  379. ->initiering ..gpa=gadptrarray som e allokerad, kan vara NIL.
  380. gle:=init(screen, gpa)
  381.  
  382. ->fria resurser (antagligen vid programslut)
  383. quit(gle)
  384.  
  385. ->sätt mellanrum mellan gadgets
  386. xspace, yspace:=setspace(gle, xspace, yspace)
  387.  
  388. ->sätt 'teckenstorlek'
  389. wf, hf:=setgadsizefactor(gle, wf, hf)
  390.  
  391. ->förflytta 'markören'
  392. cpx:=mleft(gle ,wval)
  393. cpx:=mright(gle, wval)
  394. cpy:=mdown(gle, hval)
  395. cpy:=mup(gle, hval)
  396. sx:=msx(gle)
  397. sy:=msy(gle)
  398.  
  399. ->x och y för msx/y
  400. setstartxy(gle, x, y)
  401.  
  402. ->addera en gad till gadlisten
  403. gad:=addgad(gle, kind, id, wval, hval, gadtxt, flags, tags)
  404.  
  405. ->sätt fonten till nåt annat än standard.
  406. settextattr(gle, textattr)
  407.  
  408. ->hämta hittils största x och y värde för markören.
  409. x:=getmaxx(gle)
  410. y:=getmaxy(gle)
  411.  
  412. ->hämta gadlisten (antagligen till fönsteröppningen)
  413. gadlist:=getglist(gle)
  414.  
  415. ->hämta nuvarande markörs xy-position
  416. x:=getcpx(gle)
  417. y:=getcpy(gle)
  418.  
  419.  
  420. */
  421.