MODULE 'intuition/classes','intuition/classusr','intuition/intuition',
       'utility/tagitem','utility/hooks',
       'exec/memory','exec/tasks','exec/execbase',
       'exec/nodes','exec/ports','exec/lists','exec/io',
       'workbench/workbench','workbench/startup',
       'datatypes/datatypes','datatypes/datatypesclass','datatypes/pictureclass',
       'graphics/view','graphics/gfx','graphics/rastport',
       'devices/timer',
       'libraries/gadtools',
       'graphics/text',
       'diskfont',
       'datatypes',
       'icon'

OBJECT arr151
  byte[151]:ARRAY
ENDOBJECT

DEF mainwin:PTR TO window,mainmsg:PTR TO intuimessage,mainsig,mainsigs,
    closegad:PTR TO gadget,draggad:PTR TO gadget,sizegad:PTR TO gadget,
    mytask:PTR TO tc,mystack,taskadded=FALSE,oldrast,textpos,
    leftedge,topedge,width,height,backpic[80]:STRING,
    mytext:PTR TO textattr,myfont:PTR TO textfont,mynode:PTR TO ln,
    fontname[80]:STRING,fontsize,sysbase:PTR TO execbase,i,j,
    wb:PTR TO wbstartup,wbargs:PTR TO wbarg,wbobj:PTR TO diskobject,
    wbname,wblock,tta,tt1,
    x1[5]:ARRAY OF LONG,y1[5]:ARRAY OF LONG,
    x2[5]:ARRAY OF LONG,y2[5]:ARRAY OF LONG,
    diffy,buffer[7]:ARRAY OF arr151,mode=0,modename,
    cputime=0,cpuload=0,cputemp=0,cputemp2,cpuctr=0,load,switchcount,
    chipscale=1,fastscale=1,pubscale=1,
    sum1=0,pos1=0,pos=0,length=0,last[61]:ARRAY OF LONG,
    curchip,curfast,curpub,maxchip,maxfast,maxpub,
    upsecs,upmins,uphours,updays,
    timeropen1=FALSE,timeropen2=FALSE,timerreq1=FALSE,timerreq2=FALSE,
    timersignal1,timersignal2,timerport1:PTR TO mn,timerport2:PTR TO mn,
    timermsg1:PTR TO timerequest,timermsg2:PTR TO timerequest,

    dtbitmap:PTR TO bitmap,dtbitmapheader:PTR TO bitmapheader,dtobject:PTR TO object,

    temprast:rastport,tempbm:PTR TO bitmap

PROC main()
DEF running=TRUE,x

    IF wbmessage<>NIL
      iconbase:=OpenLibrary('icon.library',37)
      wb    :=wbmessage
      wbargs:=wb.arglist
      wbname:=wbargs.name
      wblock:=wbargs.lock
      CurrentDir(wblock)
      IF wbobj:=GetDiskObject(wbname)
        tta:=wbobj.tooltypes
        IF (tt1:=FindToolType(tta,'LEFTEDGE')) THEN leftedge:=Val(tt1,{x}) ELSE leftedge:=0
        IF (tt1:=FindToolType(tta,'TOPEDGE'))  THEN topedge:=Val(tt1,{x})  ELSE topedge:=0
        IF (tt1:=FindToolType(tta,'WIDTH'))    THEN width:=Val(tt1,{x})    ELSE width:=190
        IF (tt1:=FindToolType(tta,'HEIGHT'))   THEN height:=Val(tt1,{x})   ELSE height:=95
        tt1:=FindToolType(tta,'BACKPIC')
        AstrCopy(backpic,tt1)
        tt1:=FindToolType(tta,'MODE')
        mode:=Val(tt1,{x})
        IF (tt1:=FindToolType(tta,'FONTNAME')) THEN AstrCopy(fontname,tt1) ELSE StrCopy(fontname,'topaz.font')
        IF (tt1:=FindToolType(tta,'FONTSIZE')) THEN fontsize:=Val(tt1,{x}) ELSE fontsize:=8
        FreeDiskObject(wbobj)
      ENDIF
      CloseLibrary(iconbase)
    ENDIF
    IF leftedge=0 THEN leftedge:=10
    IF topedge =0 THEN topedge :=10
    IF width   =0 THEN width   :=190
    IF height  =0 THEN height  :=95

    diskfontbase :=OpenLibrary('diskfont.library',37)
    datatypesbase:=OpenLibrary('datatypes.library',37)
    sysbase      :=execbase

    FOR i:=0 TO 6
      FOR j:=0 TO 150 DO buffer[i].byte[j]:=0
    ENDFOR

    modename:=['Busy','Idle','Load','Switch','Chip','Fast','Public']

    draggad :=[NIL,0,1,0,0,GFLG_GADGHNONE,GACT_IMMEDIATE,
               GTYP_SYSGADGET OR GTYP_WDRAGGING,0,0,0,0,0,1,0]:gadget
    closegad:=[NIL,0,0,16,16,NIL,GACT_IMMEDIATE,
               GTYP_SYSGADGET OR GTYP_CLOSE,0,0,0,0,0,2,0]:gadget
    sizegad :=[NIL,0,0,16,16,GFLG_GADGHNONE,GACT_IMMEDIATE,
               GTYP_SYSGADGET OR GTYP_SIZING,0,0,0,0,0,3,0]:gadget

    mainwin:=OpenWindowTagList(NIL,[WA_LEFT ,leftedge,WA_TOP,topedge,
                                    WA_WIDTH,width,WA_HEIGHT,height,
                                    WA_MAXWIDTH,800,WA_MAXHEIGHT,600,
                                    WA_MINWIDTH,width,WA_MINHEIGHT,height,
                                    WA_IDCMP,IDCMP_CLOSEWINDOW OR IDCMP_NEWSIZE OR IDCMP_MOUSEBUTTONS,
                                    WA_FLAGS,WFLG_BORDERLESS OR WFLG_RMBTRAP,
                                    WA_AUTOADJUST,TRUE,
                                    NIL])

    loadbackground()

    mytext:=[fontname,fontsize,FSF_BOLD,0]:textattr
    myfont:=OpenDiskFont(mytext)
    SetFont(mainwin.rport,myfont)

    oldrast:=SetStdRast(mainwin.rport)

    draggad.width   :=mainwin.width
    draggad.height  :=mainwin.height-17
    sizegad.topedge :=mainwin.height-16
    sizegad.leftedge:=mainwin.width -16
    AddGadget(mainwin,draggad, 0)
    AddGadget(mainwin,sizegad, 0)
    AddGadget(mainwin,closegad,0)

    mystack:=AllocMem(1000,MEMF_CLEAR)
    mytask :=AllocMem(SIZEOF tc,MEMF_CLEAR OR MEMF_PUBLIC)
    timerport1:=CreateMsgPort()
    timermsg1 :=CreateIORequest(timerport1,SIZEOF timerequest)
    OpenDevice('timer.device',UNIT_VBLANK,timermsg1,0)
    timeropen1:=TRUE;
    timersignal1:=Shl(1,timerport1::mp.sigbit)
    timerport2:=CreateMsgPort()
    timermsg2 :=CreateIORequest(timerport2,SIZEOF timerequest)
    OpenDevice('timer.device',UNIT_VBLANK,timermsg2,0)
    timeropen2:=TRUE;
    timersignal2:=Shl(1,timerport2::mp.sigbit)

    addtimerequest1(1,00)
    addtimerequest2(0,10)

    mytask::ln.type :=NT_TASK
    mytask::ln.name :='PerfWatchIdle'
    mytask::ln.pri  :=-128
    mytask.splower  :=mystack
    mytask.spupper  :=mystack+1000
    mytask.spreg    :=mytask.spupper

    LEA     savearea(PC),A3
    MOVE.L  A4,0(A3)
    MOVE.L  A5,4(A3)
    AddTask(mytask,{idletask},0)
    taskadded:=TRUE

    getmem()         -> Maximalen Speicher (C/F/P) ermitteln
    drawallborders() -> Rahmen zeichnen
    calculatelines() -> Prozentlinien ermitteln    
    updatebuffer()   -> Erste Werte eintragen

    mainsig:=Shl(1,mainwin.userport.sigbit)
    WHILE running
      mainsigs:=Wait(mainsig OR timersignal1 OR timersignal2)
      IF mainsigs AND mainsig
        WHILE mainmsg:=GetMsg(mainwin.userport)
          IF mainmsg.class=IDCMP_CLOSEWINDOW THEN running:=FALSE
          IF mainmsg.class=IDCMP_NEWSIZE
            draggad.width   :=mainwin.width
            draggad.height  :=mainwin.height-17
            sizegad.topedge :=mainwin.height-16
            sizegad.leftedge:=mainwin.width -16
            RefreshGList(mainwin.firstgadget,mainwin,NIL,0)
            drawallborders()
            calculatelines()
          ENDIF
          IF mainmsg.class=IDCMP_MOUSEBUTTONS
            IF mainmsg.code=MENUUP
              mode:=mode+1
              IF mode>6 THEN mode:=0
              drawallborders()
              calculatelines()
            ENDIF
          ENDIF
          ReplyMsg(mainmsg)
        ENDWHILE
      ENDIF
      IF mainsigs AND timersignal1
        GetMsg(timerport1)
        addtimerequest1(1,0)
        uptime()
        IF (100*cputime/60) < 100 THEN cputemp:=cputime
        cputemp2:=cputemp2+(100*cputime/60)
        cputime:=0
        INC cpuctr
        IF cpuctr=0 THEN cpuctr:=1
        cpuload:=Div(cputemp2,cpuctr)
        length:=0
        mynode:=sysbase.taskready::lh.head
        Disable()
        REPEAT
          INC length
          mynode:=mynode::ln.succ
        UNTIL mynode=0
        Enable()
        sum1:=sum1+(length-last[pos1])
        last[pos]:=length
        IF pos1++ = 60 THEN pos1:=0
        IF pos++  = 60 THEN pos :=0
        load:=(sum1*100+50)/480
        IF load > 100 THEN load:=100
        updatebuffer()
        drawvalues()
        switchcount:=0
      ENDIF
      IF mainsigs AND timersignal2
        GetMsg(timerport2)
        addtimerequest2(0,8)
      ENDIF
    ENDWHILE

    IF timeropen2
      IF timerreq2
        AbortIO(timermsg2)
        WaitIO(timermsg2)
      ENDIF
      CloseDevice(timermsg2)
    ENDIF
    IF timermsg2  THEN DeleteIORequest(timermsg2)
    IF timerport2 THEN DeleteMsgPort(timerport2)
    IF timeropen1
      IF timerreq1
        AbortIO(timermsg1)
        WaitIO(timermsg1)
      ENDIF
      CloseDevice(timermsg1)
    ENDIF
    IF timermsg1  THEN DeleteIORequest(timermsg1)
    IF timerport1 THEN DeleteMsgPort(timerport1)

    IF taskadded  THEN RemTask(mytask)
    IF mytask     THEN FreeMem(mytask,SIZEOF tc)
    IF mystack    THEN FreeMem(mystack,1000)

    RemoveGList(mainwin,mainwin.firstgadget,-1)
    SetStdRast(oldrast)
    freebackground()
    CloseWindow(mainwin)
    IF tempbm        THEN FreeBitMap(tempbm)
    IF datatypesbase THEN CloseLibrary(datatypesbase)
    IF diskfontbase  THEN CloseLibrary(diskfontbase)
ENDPROC

savearea: LONG 0,0

PROC blittiledbitmap(src,ssizex,ssizey,dst)
DEF posx,posy,sizex,sizey
  sizex:=Min(ssizex,mainwin.width)
  posx:=0
  WHILE posx<mainwin.width
    sizey:=Min(ssizey,mainwin.height)
    posy:=0
    WHILE posy<mainwin.height
      BltBitMapRastPort(src,0,0,dst,posx,posy,sizex,sizey,$C0)
      WaitBlit()
      posy :=posy+sizey
      sizey:=Min(sizey,mainwin.height-posy)
    ENDWHILE
    posx :=posx+sizex
    sizex:=Min(sizex,mainwin.width-posx)
  ENDWHILE
ENDPROC

PROC drawallborders()
  SetAPen(mainwin.rport,0)
  RectFill(mainwin.rport,0,0,mainwin.width,mainwin.height)
  IF tempbm THEN FreeBitMap(tempbm)
  tempbm:=AllocBitMap(mainwin.width,mainwin.height,mainwin.rport.bitmap.depth,BMF_CLEAR,0)
  InitRastPort(temprast)
  temprast.bitmap:=tempbm
  IF dtbitmapheader<>NIL
    blittiledbitmap(dtbitmap,dtbitmapheader.width,dtbitmapheader.height,mainwin.rport)
    blittiledbitmap(dtbitmap,dtbitmapheader.width,dtbitmapheader.height,temprast)
  ENDIF
  SetAPen(mainwin.rport,0)
  drawborder(0,0,mainwin.width-1,mainwin.height-1,1,2,mainwin.rport)
  SetAPen(mainwin.rport,0)
  RectFill(mainwin.rport,5,5,mainwin.width-6,mainwin.height-21)
  drawborder(5,5,mainwin.width-6,mainwin.height-21,2,1,mainwin.rport)
ENDPROC

PROC drawborder(x1,y1,x2,y2,col1,col2,rp)
  SetAPen(rp,col1)
  RectFill(rp,x2,y1+1,x2,y2)
  RectFill(rp,x1,y2,x2,y2)
  SetAPen(rp,col2)
  RectFill(rp,x1,y1,x1,y2)
  RectFill(rp,x1,y1,x2-1,y1)
ENDPROC

PROC calculatelines()
DEF size,count
  size:=Div(mainwin.height-21,6)
  x1[0]:=6;          x2[0]:=mainwin.width-7 -> 100% line
  y1[0]:=5+size;     y2[0]:=5+size
  x1[1]:=6;          x2[1]:=mainwin.width-7
  y1[1]:=y1[0]+size; y2[1]:=y2[0]+size
  x1[2]:=6;          x2[2]:=mainwin.width-7
  y1[2]:=y1[1]+size; y2[2]:=y2[1]+size
  x1[3]:=6;          x2[3]:=mainwin.width-7
  y1[3]:=y1[2]+size; y2[3]:=y2[2]+size
  x1[4]:=6;          x2[4]:=mainwin.width-7 -> 000% line
  y1[4]:=y1[3]+size; y2[4]:=y2[3]+size
  textpos:=mainwin.height-8
  diffy  :=y2[4]-y2[0]
  FOR count:=0 TO 4
    SetAPen(mainwin.rport,4)
    IF count=2 THEN SetAPen(mainwin.rport,5)
    Move(mainwin.rport,x1[count],y1[count])
    Draw(mainwin.rport,x2[count],y2[count])
  ENDFOR
ENDPROC

PROC updatebuffer()
  FOR i:=0 TO 6
    FOR j:=0 TO 150 
      buffer[i].byte[j]:=buffer[i].byte[j+1]
    ENDFOR
  ENDFOR
  curchip:=AvailMem(MEMF_CHIP)
  curfast:=AvailMem(MEMF_FAST)
  curpub :=AvailMem(MEMF_PUBLIC)
  buffer[0].byte[150]:=(100*cputemp/60)        -> Busy
  buffer[1].byte[150]:=100-buffer[0].byte[150] -> Idle
  buffer[2].byte[150]:=100-load                -> Load
  buffer[3].byte[150]:=100-switchcount         -> Switch
  buffer[4].byte[150]:=Div(curchip,chipscale)  -> Chip
  buffer[5].byte[150]:=Div(curfast,fastscale)  -> Fast
  buffer[6].byte[150]:=Div(curpub,pubscale)    -> Public
ENDPROC

PROC getmem()
  maxchip:=getmaxmem(MEMF_CHIP)
  maxfast:=getmaxmem(MEMF_FAST)
  maxpub :=maxchip+maxfast
  chipscale:=Div(maxchip,100)
  fastscale:=Div(maxfast,100)
  IF fastscale=0 THEN fastscale:=1
  pubscale :=Div(maxpub,100)
ENDPROC

PROC getmaxmem(memtype)
DEF blocksize=0,mymemhdr:PTR TO mh
  Forbid()
  mymemhdr:=sysbase.memlist::lh.head
  REPEAT
    IF mymemhdr.attributes AND memtype = memtype THEN
      blocksize:=blocksize+mymemhdr.upper-mymemhdr.lower
    mymemhdr:=mymemhdr::ln.succ
  UNTIL mymemhdr=0
  Permit()
  RETURN blocksize
ENDPROC

PROC drawvalues()
DEF count
  SetBPen(mainwin.rport,0)
  ScrollRaster(mainwin.rport,1,0,x1[0],y1[0],x2[4],y2[4])
  FOR count:=0 TO 4
    SetAPen(mainwin.rport,4)
    IF count=2 THEN SetAPen(mainwin.rport,5)
    WritePixel(mainwin.rport,x2[0],y2[count])
  ENDFOR
  SetAPen(mainwin.rport,1)
  Move(mainwin.rport,x2[0]-1,y2[0]+(buffer[mode].byte[149]*diffy/100))
  Draw(mainwin.rport,x2[0]  ,y2[0]+(buffer[mode].byte[150]*diffy/100))
  IF dtbitmapheader<>NIL
    ClipBlit(temprast,5,mainwin.height-20,mainwin.rport,5,mainwin.height-20,mainwin.width-10,15,$c0)
    WaitBlit()
  ELSE
    SetAPen(mainwin.rport,0)
    RectFill(mainwin.rport,5,mainwin.height-20,mainwin.width-10,mainwin.height-5)
    SetAPen(mainwin.rport,1)
  ENDIF
  SetDrMd(mainwin.rport,RP_JAM1)
  TextF(x1[0],textpos,'\s: \d% Up: \d.\z\d[2]:\z\d[2]',
        ListItem(modename,mode),100-buffer[mode].byte[150],updays,uphours,upmins)
ENDPROC

PROC addtimerequest1(secs,micros)
  timerreq1:=TRUE
  timermsg1::io.command        :=TR_ADDREQUEST
  timermsg1.time::timeval.secs :=secs
  timermsg1.time::timeval.micro:=micros
  SendIO(timermsg1)
ENDPROC

PROC addtimerequest2(secs,micros)
  timerreq2:=TRUE
  timermsg2::io.command        :=TR_ADDREQUEST
  timermsg2.time::timeval.secs :=secs
  timermsg2.time::timeval.micro:=micros
  SendIO(timermsg2)
ENDPROC

switchroutine:
  MOVEM.L A0-A6/D0-D7,-(A7)
  LEA    savearea(PC),A3
  MOVE.L 0(A3),A4
  MOVE.L 4(A3),A5
  cputime:=cputime+(sysbase.quantum-sysbase.elapsed)
  INC switchcount
  MOVEM.L (A7)+,A0-A6/D0-D7
  RTS

idletask:
  MOVEM.L A0-A6/D0-D7,-(A7)
  LEA    savearea(PC),A3
  MOVE.L 0(A3),A4
  MOVE.L 4(A3),A5
  Disable();
  mytask.switch:={switchroutine}
  mytask.flags :=mytask.flags OR TF_SWITCH
  Enable();
  WHILE TRUE
    NOP
  ENDWHILE
  MOVEM.L (A7)+,A0-A6/D0-D7
  RTS

PROC uptime()
  IF upsecs++ = 59
    upsecs:=0
    IF upmins++ = 59
      upmins:=0
      IF uphours++ = 23
        uphours:=0
        INC updays
      ENDIF
    ENDIF
  ENDIF
ENDPROC

PROC loadbackground()
  IF (dtobject:=NewDTObjectA(backpic,[DTA_SOURCETYPE,DTST_FILE,
                                      DTA_GROUPID,GID_PICTURE,
                                      PDTA_REMAP,TRUE,
                                      PDTA_SCREEN,mainwin.wscreen,
                                      PDTA_FREESOURCEBITMAP,TRUE,
                                      OBP_PRECISION,PRECISION_IMAGE,
                                      NIL]))
    DoDTMethodA(dtobject,NIL,NIL,[DTM_PROCLAYOUT,0,1])
    GetDTAttrsA(dtobject,[PDTA_DESTBITMAP,{dtbitmap},PDTA_BITMAPHEADER,{dtbitmapheader},NIL])
  ELSE
    dtbitmap      :=0
    dtbitmapheader:=0
  ENDIF
ENDPROC

PROC freebackground()
  IF dtobject THEN DisposeDTObject(dtobject)
ENDPROC

VOID '$VER 3.0 21-nov-1995 by f.fenn@cross.berlinet.de'