OPT PREPROCESS

MODULE  'graphics/rastport','graphics/text',
		'utility','utility/tagitem',
		'feelin','libraries/feelin','a4'

LIBRARY  FC_Text,3,82,'Feelin: Text Class 3.82 (07-04-02) by Olivier Laviale (lotan9@aol.com)' IS class_Setup(A0,A1)

PROC main() IS sys_SGlob()

OBJECT mydata
   flags
   text:PTR TO CHAR
   prep[2]:ARRAY OF LONG
   textdisplay:PTR TO feelinTextDisplay
ENDOBJECT

CONST    FF_Text_HCenter  = %0001,
		 FF_Text_VCenter  = %0010,
		 FF_Text_NoBuffer = %0100,
		 FF_Text_SetMin   = %1000

->ENDPROC

PROC class_Setup(set:PTR TO feelinSetup,server:PTR TO feelinServer)
   feelinbase  := server.feelin
   utilitybase := server.feelin.utility

   set.superid := FC_Area
   set.size    := SIZEOF mydata
   set.disp    := {class_Dispatcher}
ENDPROC TRUE
PROC class_Dispatcher(cl=A2:PTR TO feelinClass,obj=A0:PTR TO feelinObject,method=D0,args=A1:PTR TO LONG)
   DEF data:PTR TO mydata

   sys_RGlob() ; SetStdOut(Output()) ; data := INST_DATA(cl,obj)

   SELECT method
	  CASE FM_New         ; RETURN text_New       (cl,obj,data,args)
	  CASE FM_Dispose     ;        text_Dispose   (cl,obj,data)
	  CASE FM_Set         ;        text_Set       (obj,data,args) ; F_SuperDoA(cl,obj,FM_Set,args)
	  CASE FM_Get         ;        text_Get       (    data,args) ; F_SuperDoA(cl,obj,FM_Get,args)

	  CASE FM_Setup
		 IF F_SuperDoA(cl,obj,FM_Setup,args)
			F_Set(data.textdisplay,FA_TextDisplay_Font,_font(obj))
			F_DoA(data.textdisplay,FM_TextDisplay_Size,[NIL])
			RETURN TRUE
		 ENDIF
	  CASE FM_Cleanup
		 F_Set(data.textdisplay,FA_TextDisplay_Font,NIL)
		 F_SuperDoA(cl,obj,FM_Cleanup,args)
	  CASE FM_AskMinMax   ;        text_AskMinMax (cl,obj,data)
	  CASE FM_Draw        ;        text_Draw      (cl,obj,data,args)

	  DEFAULT
		 RETURN F_SuperDoA(cl,obj,method,args)
   ENDSELECT
ENDPROC

->-- Methods --<-------------------------------------------------------------

PROC text_New(cl,obj:PTR TO feelinObject,data:PTR TO mydata,tags)
   DEF item:PTR TO tagitem

   data.flags := FF_Text_HCenter OR FF_Text_SetMin

   IF item := F_NewObjA(FC_TextDisplay,tags)
	  data.textdisplay := item

	  IF F_SuperDoA(cl,obj,FM_New,tags)
		 WHILE item := NextTagItem({tags})
			SELECT item.tag
			   CASE FA_Text_SetMin   ; data.flags := IF item.data THEN data.flags OR FF_Text_SetMin   ELSE data.flags - (data.flags AND FF_Text_SetMin)
			   CASE FA_Text_NoBuffer ; data.flags := IF item.data THEN data.flags OR FF_Text_NoBuffer ELSE data.flags - (data.flags AND FF_Text_NoBuffer)
			ENDSELECT
		 ENDWHILE

		 RETURN obj
	  ENDIF
   ENDIF
ENDPROC
PROC text_Dispose(cl,obj:PTR TO feelinObject,data:PTR TO mydata)
   data.textdisplay := F_DisposeObj(data.textdisplay)
   IF FF_Text_NoBuffer AND data.flags = NIL THEN data.text := F_Dispose(data.text)
   F_SuperDoA(cl,obj,FM_Dispose,NIL)
ENDPROC
PROC text_Set(obj:PTR TO feelinObject,data:PTR TO mydata,tags)
   DEF item:PTR TO tagitem,temp

   WHILE item := NextTagItem({tags})
	  SELECT item.tag
		 CASE FA_Text
			IF FF_Text_NoBuffer AND data.flags
			   data.text := item.data
			ELSE
			   data.text := F_Dispose(data.text)

			   IF item.data
				  IF temp := StrLen(item.data)
					 IF data.text := F_New(temp+1) THEN CopyMem(item.data,data.text,temp)
				  ENDIF
			   ENDIF
			ENDIF

			F_Set(data.textdisplay,FA_Text,data.text)
			IF temp := F_Get(data.textdisplay,FA_TextDisplay_UnderShort) THEN F_Set(obj,FA_ControlChar,temp)
			F_Draw(obj,FF_Draw_Update OR FF_Draw_Fill)

		 CASE FA_Text_PreParse    ; data.prep[0] := item.data
		 CASE FA_Text_AltPreParse ; data.prep[1] := item.data
		 CASE FA_Text_HCenter     ; data.flags := IF item.data THEN data.flags OR FF_Text_HCenter ELSE data.flags - (data.flags AND FF_Text_HCenter)
		 CASE FA_Text_VCenter     ; data.flags := IF item.data THEN data.flags OR FF_Text_VCenter ELSE data.flags - (data.flags AND FF_Text_VCenter)
	  ENDSELECT
   ENDWHILE
ENDPROC
PROC text_Get(data:PTR TO mydata,tags)
   DEF item:PTR TO tagitem,save

   WHILE item := NextTagItem({tags}) ; save := item.data
	  SELECT item.tag
		 CASE FA_Text             ; ^save := data.text
		 CASE FA_Text_PreParse    ; ^save := data.prep[0]
		 CASE FA_Text_AltPreParse ; ^save := data.prep[1]
		 CASE FA_Text_HCenter     ; ^save := NIL <> (FF_Text_HCenter AND data.flags)
		 CASE FA_Text_VCenter     ; ^save := NIL <> (FF_Text_VCenter AND data.flags)
	  ENDSELECT
   ENDWHILE
ENDPROC

PROC text_AskMinMax(cl,obj:PTR TO feelinObject,data:PTR TO mydata)
   DEF td:PTR TO feelinTextDisplay

   IF data.text
	  IF td := data.textdisplay
		 F_Set(td,FA_TextDisplay_Font,_font(obj))

		 IF FF_Text_SetMin AND data.flags THEN _minw(obj) += td.width
		 _minh(obj) += td.height
	  ENDIF
   ELSE
	  _minh(obj) += _font(obj).ysize
   ENDIF

->   WriteF('Text.AskMinMax - Min \d, \d - Font \d\n',_minw(data),_minh(data),_font(obj).ysize)

   F_SuperDoA(cl,obj,FM_AskMinMax,NIL)
ENDPROC
PROC text_Draw(cl,obj:PTR TO feelinObject,data:PTR TO mydata,args)
   DEF td:PTR TO feelinTextDisplay,
	   td_draw:FS_TextDisplay_Draw,rect:feelinRect,
	   prep,h

   F_SuperDoA(cl,obj,FM_Draw,args) ; td := data.textdisplay

   rect.x1 := _mleft(obj) ; rect.x2 := _mright(obj)  ; td_draw.rect   := rect
   rect.y1 := _mtop(obj)  ; rect.y2 := _mbottom(obj) ; td_draw.render := _render(obj)

   prep := data.prep[IF F_Get(obj,FA_Selected) THEN 1 ELSE 0]
   IF prep = NIL THEN prep := data.prep[]

   IF FF_Text_VCenter AND data.flags
	  IF td.height < (h := rect.y2 - rect.y1 + 1)
		 rect.y1 := h - td.height / 2 + rect.y1
	  ENDIF
   ENDIF

   IF td.text := prep      THEN F_DoA(td,FM_TextDisplay_Draw,td_draw)
   IF td.text := data.text THEN F_DoA(td,FM_TextDisplay_Draw,td_draw)
ENDPROC

->-- Private --<-------------------------------------------------------------

/* PROC Historique

   3.80 (02.12.01)

	  Modification du code pour un véritable objet, plus de dépendance avec
	  Area.fcc (mydata OF feelinArea).

   3.82 (07-04-02)

	  Utilisation de l'attribut FA_TextDisplay_UnderShort pour  obtenir  le
	  raccourcis clavier.

ENDPROC ********************************************************************/