/* E Source generated by SRCGEN v0.4 */

OPT OSVERSION=37,REG=5

MODULE 'gadtools',
       'libraries/gadtools',
       'intuition/intuition',
       'intuition/screens',
       'intuition/gadgetclass',
       'intuition/iobsolete',
       'utility/tagitem',
       'devices/inputevent',
       'graphics/text',
       'tools/detatch'

ENUM ERROR_NONE,
     ERROR_CONTEXT,
     ERROR_GADGET,
     ERROR_WB,
     ERROR_VISUAL,
     ERROR_GT,
     ERROR_WINDOW,
     ERROR_MENUS

ENUM G_SRC,G_DST,G_STR,G_TXT,G_CB
ENUM DECI,HEX,BIN,ASCII,FLOAT,OCTAL

DEF infos:PTR TO gadget,
    wnd:PTR TO window,
    glist,
    scr:PTR TO screen,
    visual=NIL,
    tattr:PTR TO textattr,
    id
DEF gsrc,gdst,gs,gt,gcb
DEF src,dst,str:PTR TO CHAR,txt[36]:STRING,num,error=FALSE

PROC setupscreen()
	IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN RETURN ERROR_GT
	IF (scr:=LockPubScreen('Workbench'))=NIL THEN RETURN ERROR_WB
	IF (visual:=GetVisualInfoA(scr,NIL))=NIL THEN RETURN ERROR_VISUAL
	tattr:=scr.font
ENDPROC

CHAR '$VER: NumConv v1.5 by MarK (30.3.2000), kuchinka@volny.cz',0

PROC closedownscreen()
	IF visual THEN FreeVisualInfo(visual)
	IF scr THEN UnlockPubScreen(NIL,scr)
	IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
ENDPROC

PROC openwindow()
  DEF g:PTR TO gadget
  IF (g:=CreateContext({glist}))=NIL THEN RETURN ERROR_CONTEXT
  IF (gsrc:=CreateGadgetA(CYCLE_KIND,g,
    [4,4,85,21,NIL,tattr,G_SRC,$0,visual,0]:newgadget,
    [GTCY_LABELS,['DEC','HEX','BIN','ASCII','FLOAT','OCTAL',0],
     GTCY_ACTIVE,DECI,
     TAG_END]))=NIL THEN RETURN ERROR_GADGET
  IF (gdst:=CreateGadgetA(CYCLE_KIND,gsrc,
    [4,28,85,21,NIL,tattr,G_DST,$0,visual,0]:newgadget,
    [GTCY_LABELS,['DEC','HEX','BIN','ASCII','FLOAT','OCTAL',0],
     GTCY_ACTIVE,HEX,
     TAG_END]))=NIL THEN RETURN ERROR_GADGET
  IF (gs:=CreateGadgetA(STRING_KIND,gdst,
    [92,4,245,21,NIL,tattr,G_STR,$0,visual,0]:newgadget,
    [GTST_MAXCHARS,34,
     TAG_END]))=NIL THEN RETURN ERROR_GADGET
  IF (gt:=CreateGadgetA(TEXT_KIND,gs,
    [92,28,269,21,NIL,tattr,G_TXT,$0,visual,0]:newgadget,
    [GTTX_BORDER,TRUE,
     TAG_END]))=NIL THEN RETURN ERROR_GADGET
  IF (gcb:=CreateGadgetA(BUTTON_KIND,gt,
    [340,4,21,21,'CB',tattr,G_CB,$0,visual,0]:newgadget,NIL))=NIL THEN RETURN ERROR_GADGET
  IF (wnd:=OpenWindowTagList(NIL,
    [WA_LEFT,0,
     WA_TOP,scr.barheight+1,
     WA_INNERWIDTH,364,
     WA_INNERHEIGHT,52,
     WA_IDCMP,IDCMP_GADGETUP OR IDCMP_GADGETDOWN OR IDCMP_CLOSEWINDOW OR IDCMP_ACTIVEWINDOW OR IDCMP_CHANGEWINDOW OR IDCMP_MOUSEBUTTONS,
     WA_FLAGS,WFLG_CLOSEGADGET OR WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_GIMMEZEROZERO OR WFLG_ACTIVATE OR WFLG_RMBTRAP,
     WA_TITLE,'NumConv v1.5 by Martin Kuchinka',
     WA_SCREENTITLE,'NoTek 2000',
     WA_CUSTOMSCREEN,scr,
     WA_AUTOADJUST,TRUE,
     WA_GADGETS,glist,
     TAG_END]))=NIL THEN RETURN ERROR_WINDOW
  Gt_RefreshWindow(wnd,NIL)
ENDPROC

PROC closewindow()
  IF wnd THEN CloseWindow(wnd)
  IF glist THEN FreeGadgets(glist)
ENDPROC

PROC process(win:PTR TO window)
  DEF type=0
  ActivateGadget(gs,win,NIL)
  REPEAT
    type:=wait4message(win)
    SELECT type
    CASE IDCMP_CLOSEWINDOW;	RETURN
    CASE IDCMP_MOUSEBUTTONS
      ActivateGadget(gs,win,NIL)
    CASE IDCMP_GADGETUP
     go:
      Gt_GetGadgetAttrsA(gsrc,win,NIL,[GTCY_ACTIVE,{src},TAG_END])
      Gt_GetGadgetAttrsA(gdst,win,NIL,[GTCY_ACTIVE,{dst},TAG_END])
      Gt_GetGadgetAttrsA(gs,win,NIL,[GTST_STRING,{str},TAG_END])
      IF id=G_CB
        Gt_SetGadgetAttrsA(gs,win,NIL,[GTST_STRING,txt,TAG_END])
        Gt_GetGadgetAttrsA(gs,win,NIL,[GTST_STRING,{str},TAG_END])
		ENDIF
      SELECT dst
      CASE DECI
        SELECT src
        CASE DECI; StringF(txt,'\d',Val(str))
        CASE HEX;  StringF(txt,'$\s',str); num:=Val(txt); StringF(txt,'\d',num)
        CASE BIN;  StringF(txt,'\d',bin2num(str))
        CASE ASCII;StringF(txt,'\d',ascii2num(str))
        CASE FLOAT;StringF(txt,'\d',RealVal(str))
        CASE OCTAL;StringF(txt,'\d',readoct(str))
        ENDSELECT
      CASE HEX
        SELECT src
        CASE DECI; StringF(txt,'\h',Val(str))
        CASE HEX;  StringF(txt,'$\s',str); num:=Val(txt); StringF(txt,'\h',num)
        CASE BIN;  StringF(txt,'\h',bin2num(str))
        CASE ASCII;StringF(txt,'\h',ascii2num(str))
        CASE FLOAT;StringF(txt,'\h',RealVal(str))
        CASE OCTAL;StringF(txt,'\h',readoct(str))
        ENDSELECT
      CASE BIN
        SELECT src
        CASE DECI; num2bin(txt,Val(str))
        CASE HEX;  StringF(txt,'$\s',str); num2bin(txt,Val(txt))
        CASE BIN;  num2bin(txt,bin2num(str))
        CASE ASCII;num2bin(txt,ascii2num(str))
        CASE FLOAT;num2bin(txt,RealVal(str))
        CASE OCTAL;num2bin(txt,readoct(str))
        ENDSELECT
      CASE ASCII
        SELECT src
        CASE DECI; num2ascii(txt,Val(str))
        CASE HEX;  StringF(txt,'$\s',str); num2ascii(txt,Val(txt))
        CASE BIN;  num2ascii(txt,bin2num(str))
        CASE ASCII;num2ascii(txt,ascii2num(str))
        CASE FLOAT;num2ascii(txt,RealVal(str))
        CASE OCTAL;num2ascii(txt,readoct(str))
        ENDSELECT
      CASE FLOAT
        SELECT src
        CASE DECI; RealF(txt,Val(str),6)
        CASE HEX;  StringF(txt,'$\s',str); RealF(txt,Val(txt),6)
        CASE BIN;  RealF(txt,bin2num(str),6)
        CASE ASCII;RealF(txt,ascii2num(str),6)
        CASE FLOAT;RealF(txt,RealVal(str),6)
        CASE OCTAL;RealF(txt,readoct(str),6)
        ENDSELECT
      CASE OCTAL
        SELECT src
        CASE DECI; writeoct(txt,Val(str))
        CASE HEX;  StringF(txt,'$\s',str); writeoct(txt,Val(txt))
        CASE BIN;  writeoct(txt,bin2num(str))
        CASE ASCII;writeoct(txt,ascii2num(str))
        CASE FLOAT;writeoct(txt,RealVal(str))
        CASE OCTAL;writeoct(txt,readoct(str))
        ENDSELECT
      ENDSELECT
      IF error=FALSE THEN Gt_SetGadgetAttrsA(gt,win,NIL,[GTTX_TEXT,txt,TAG_END])
      error:=FALSE
      ActivateGadget(gs,win,NIL)
    DEFAULT;		JUMP go
    ENDSELECT
  UNTIL type=IDCMP_CLOSEWINDOW
ENDPROC

PROC wait4message(win:PTR TO window)
  DEF mes:PTR TO intuimessage,type
  REPEAT
    type:=0
    IF mes:=Gt_GetIMsg(win.userport)
      type:=mes.class
      IF type=IDCMP_GADGETUP
        infos:=mes.iaddress
        id:=infos.gadgetid
      ENDIF
      Gt_ReplyIMsg(mes)
    ELSE
      WaitPort(win.userport)
    ENDIF
  UNTIL type
ENDPROC type

PROC reporterr(er)
  DEF erlist:PTR TO LONG
  IF er
    erlist:=['get context',
             'create gadget',
             'lock wb',
             'get visual infos',
             'open "gadtools.library" v37+',
             'open window',
             'create menus']
    EasyRequestArgs(0,[20,0,0,'Could not \s!','OK'],0,[erlist[er-1]])
  ENDIF
ENDPROC er

PROC main() HANDLE
  detatch('NumConv')
  IF reporterr(setupscreen())=0
    reporterr(openwindow())
    process(wnd)
    closewindow()
    IF CtrlC() THEN Raise(ERROR_NONE)
  ENDIF
  Raise(ERROR_NONE)
EXCEPT
  closedownscreen()
ENDPROC

PROC bin2num(str:PTR TO CHAR)
	DEF num=0,n=0
	WHILE str[n]="0" DO n++
	WHILE str[n]
		IF str[n]="0";			num:=Shl(num,1)
		ELSEIF str[n]="1";	num:=Shl(num,1) OR 1
		ELSE
			Gt_SetGadgetAttrsA(gt,wnd,NIL,[GTTX_TEXT,'Illegal Character',TAG_END])
			error:=TRUE
		ENDIF
		n++
	ENDWHILE
ENDPROC num

PROC ascii2num(str:PTR TO CHAR)
	DEF num,s=0
	num:=^str
	IF (num AND $00ff0000)=0 THEN s:=3 ELSE IF (num AND $0000ff00)=0 THEN s:=2 ELSE IF (num AND $000000ff)=0 THEN s:=1
	num:=Shr(num,s*8)
ENDPROC num

PROC num2bin(txt:PTR TO CHAR,num)
	DEF n=31,i=0
	WHILE n+1
		txt[i]:=IF num AND Shl(1,n) THEN "1" ELSE "0"
		n--
		i++
	ENDWHILE
	txt[i]:=0
ENDPROC

PROC num2ascii(txt:PTR TO CHAR,num)
	DEF n
	IF num<=$ff;	num:=Shl(num,24)
	ELSEIF num<=$ffff;	num:=Shl(num,16)
	ELSEIF num<=$ffffff;	num:=Shl(num,8)
	ENDIF
	^txt:=num
	txt[4]:=0
	FOR n:=0 TO 3
		IF ((txt[n]>="\0") AND (txt[n]<" ")) OR ((txt[n]>=128) AND (txt[n]<160)) THEN txt[n]:="."
	ENDFOR
ENDPROC

PROC readoct(txt:PTR TO CHAR)
	DEF	n=0,num=0
	WHILE txt[n]
		IF (txt[n]>="0") AND (txt[n]<="7")
			num:=Shl(num,3)
			num:=num OR (txt[n] AND $7)
		ELSE
			Gt_SetGadgetAttrsA(gt,wnd,NIL,[GTTX_TEXT,'Illegal Character',TAG_END])
			error:=TRUE
		ENDIF
		n++
	EXIT n=12
	ENDWHILE
ENDPROC num

PROC writeoct(txt:PTR TO CHAR,num)
	DEF n,m,i=0
	FOR n:=0 TO 10
		IF num AND Shl(7,n*3) THEN m:=n
	ENDFOR

	WHILE m+1
		txt[i]:=(Shr(num,m*3) AND 7)+"0"
		i++
		m--
	ENDWHILE
	txt[i]:=0
ENDPROC num